module Ki.Duration
  ( Duration (..),
    toMicroseconds,
    microseconds,
    milliseconds,
    seconds,
  )
where

import Data.Data (Data)
import Data.Fixed
import Ki.Prelude

-- | A length of time with microsecond precision. Numeric literals are treated as seconds.
newtype Duration = Duration (Fixed E6)
  deriving stock (Typeable Duration
DataType
Constr
Typeable Duration
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Duration -> c Duration)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Duration)
-> (Duration -> Constr)
-> (Duration -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Duration))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration))
-> ((forall b. Data b => b -> b) -> Duration -> Duration)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Duration -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Duration -> r)
-> (forall u. (forall d. Data d => d -> u) -> Duration -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Duration -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Duration -> m Duration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Duration -> m Duration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Duration -> m Duration)
-> Data Duration
Duration -> DataType
Duration -> Constr
(forall b. Data b => b -> b) -> Duration -> Duration
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Duration -> c Duration
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Duration
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Duration -> u
forall u. (forall d. Data d => d -> u) -> Duration -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Duration
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Duration -> c Duration
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Duration)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration)
$cDuration :: Constr
$tDuration :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Duration -> m Duration
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
gmapMp :: (forall d. Data d => d -> m d) -> Duration -> m Duration
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
gmapM :: (forall d. Data d => d -> m d) -> Duration -> m Duration
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
gmapQi :: Int -> (forall d. Data d => d -> u) -> Duration -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Duration -> u
gmapQ :: (forall d. Data d => d -> u) -> Duration -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Duration -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
gmapT :: (forall b. Data b => b -> b) -> Duration -> Duration
$cgmapT :: (forall b. Data b => b -> b) -> Duration -> Duration
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Duration)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Duration)
dataTypeOf :: Duration -> DataType
$cdataTypeOf :: Duration -> DataType
toConstr :: Duration -> Constr
$ctoConstr :: Duration -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Duration
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Duration
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Duration -> c Duration
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Duration -> c Duration
$cp1Data :: Typeable Duration
Data, (forall x. Duration -> Rep Duration x)
-> (forall x. Rep Duration x -> Duration) -> Generic Duration
forall x. Rep Duration x -> Duration
forall x. Duration -> Rep Duration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Duration x -> Duration
$cfrom :: forall x. Duration -> Rep Duration x
Generic)
  deriving newtype (Int -> Duration
Duration -> Int
Duration -> [Duration]
Duration -> Duration
Duration -> Duration -> [Duration]
Duration -> Duration -> Duration -> [Duration]
(Duration -> Duration)
-> (Duration -> Duration)
-> (Int -> Duration)
-> (Duration -> Int)
-> (Duration -> [Duration])
-> (Duration -> Duration -> [Duration])
-> (Duration -> Duration -> [Duration])
-> (Duration -> Duration -> Duration -> [Duration])
-> Enum Duration
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Duration -> Duration -> Duration -> [Duration]
$cenumFromThenTo :: Duration -> Duration -> Duration -> [Duration]
enumFromTo :: Duration -> Duration -> [Duration]
$cenumFromTo :: Duration -> Duration -> [Duration]
enumFromThen :: Duration -> Duration -> [Duration]
$cenumFromThen :: Duration -> Duration -> [Duration]
enumFrom :: Duration -> [Duration]
$cenumFrom :: Duration -> [Duration]
fromEnum :: Duration -> Int
$cfromEnum :: Duration -> Int
toEnum :: Int -> Duration
$ctoEnum :: Int -> Duration
pred :: Duration -> Duration
$cpred :: Duration -> Duration
succ :: Duration -> Duration
$csucc :: Duration -> Duration
Enum, Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq, Num Duration
Num Duration
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Rational -> Duration)
-> Fractional Duration
Rational -> Duration
Duration -> Duration
Duration -> Duration -> Duration
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Duration
$cfromRational :: Rational -> Duration
recip :: Duration -> Duration
$crecip :: Duration -> Duration
/ :: Duration -> Duration -> Duration
$c/ :: Duration -> Duration -> Duration
$cp1Fractional :: Num Duration
Fractional, Integer -> Duration
Duration -> Duration
Duration -> Duration -> Duration
(Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Integer -> Duration)
-> Num Duration
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Duration
$cfromInteger :: Integer -> Duration
signum :: Duration -> Duration
$csignum :: Duration -> Duration
abs :: Duration -> Duration
$cabs :: Duration -> Duration
negate :: Duration -> Duration
$cnegate :: Duration -> Duration
* :: Duration -> Duration -> Duration
$c* :: Duration -> Duration -> Duration
- :: Duration -> Duration -> Duration
$c- :: Duration -> Duration -> Duration
+ :: Duration -> Duration -> Duration
$c+ :: Duration -> Duration -> Duration
Num, Eq Duration
Eq Duration
-> (Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
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 :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmax :: Duration -> Duration -> Duration
>= :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c< :: Duration -> Duration -> Bool
compare :: Duration -> Duration -> Ordering
$ccompare :: Duration -> Duration -> Ordering
$cp1Ord :: Eq Duration
Ord, ReadPrec [Duration]
ReadPrec Duration
Int -> ReadS Duration
ReadS [Duration]
(Int -> ReadS Duration)
-> ReadS [Duration]
-> ReadPrec Duration
-> ReadPrec [Duration]
-> Read Duration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Duration]
$creadListPrec :: ReadPrec [Duration]
readPrec :: ReadPrec Duration
$creadPrec :: ReadPrec Duration
readList :: ReadS [Duration]
$creadList :: ReadS [Duration]
readsPrec :: Int -> ReadS Duration
$creadsPrec :: Int -> ReadS Duration
Read, Num Duration
Ord Duration
Num Duration
-> Ord Duration -> (Duration -> Rational) -> Real Duration
Duration -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Duration -> Rational
$ctoRational :: Duration -> Rational
$cp2Real :: Ord Duration
$cp1Real :: Num Duration
Real, Fractional Duration
Real Duration
Real Duration
-> Fractional Duration
-> (forall b. Integral b => Duration -> (b, Duration))
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> RealFrac Duration
Duration -> b
Duration -> b
Duration -> b
Duration -> b
Duration -> (b, Duration)
forall b. Integral b => Duration -> b
forall b. Integral b => Duration -> (b, Duration)
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 :: Duration -> b
$cfloor :: forall b. Integral b => Duration -> b
ceiling :: Duration -> b
$cceiling :: forall b. Integral b => Duration -> b
round :: Duration -> b
$cround :: forall b. Integral b => Duration -> b
truncate :: Duration -> b
$ctruncate :: forall b. Integral b => Duration -> b
properFraction :: Duration -> (b, Duration)
$cproperFraction :: forall b. Integral b => Duration -> (b, Duration)
$cp2RealFrac :: Fractional Duration
$cp1RealFrac :: Real Duration
RealFrac, Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show)

toMicroseconds :: Duration -> Int
toMicroseconds :: Duration -> Int
toMicroseconds (Duration (MkFixed Integer
us)) =
  Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
us

-- | One microsecond.
microseconds :: Duration
microseconds :: Duration
microseconds =
  Fixed E6 -> Duration
Duration (Integer -> Fixed E6
forall k (a :: k). Integer -> Fixed a
MkFixed Integer
1)

-- | One millisecond.
milliseconds :: Duration
milliseconds :: Duration
milliseconds =
  Fixed E6 -> Duration
Duration (Integer -> Fixed E6
forall k (a :: k). Integer -> Fixed a
MkFixed Integer
1000)

-- | One second.
seconds :: Duration
seconds :: Duration
seconds =
  Fixed E6 -> Duration
Duration (Integer -> Fixed E6
forall k (a :: k). Integer -> Fixed a
MkFixed Integer
1000000)