module Postgres.Time
  ( Interval,
    fromMicroseconds,
    fromMilliseconds,
    fromSeconds,
    microseconds,
    milliseconds,
    seconds,
  )
where

-- | A type representing a time interval.
newtype Interval = Interval
  { -- | Get the duration of an interval in microseconds.
    Interval -> Int
microseconds :: Int
  }
  deriving (Interval -> Interval -> Bool
(Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool) -> Eq Interval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval -> Interval -> Bool
$c/= :: Interval -> Interval -> Bool
== :: Interval -> Interval -> Bool
$c== :: Interval -> Interval -> Bool
Eq, Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
(Int -> Interval -> ShowS)
-> (Interval -> String) -> ([Interval] -> ShowS) -> Show Interval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval] -> ShowS
$cshowList :: [Interval] -> ShowS
show :: Interval -> String
$cshow :: Interval -> String
showsPrec :: Int -> Interval -> ShowS
$cshowsPrec :: Int -> Interval -> ShowS
Show)

-- | Create an `Interval` lasting a certain number of microseconds.
fromMicroseconds :: Int -> Interval
fromMicroseconds :: Int -> Interval
fromMicroseconds = Int -> Interval
Interval

-- | Get the duration of an interval in seconds.
seconds :: Interval -> Float
seconds :: Interval -> Float
seconds Interval
interval = Float
1e-6 Float -> Float -> Float
forall number. Num number => number -> number -> number
* Int -> Float
toFloat (Interval -> Int
microseconds Interval
interval)

-- | Create an `Interval` lasting a certain number of seconds.
fromSeconds :: Float -> Interval
fromSeconds :: Float -> Interval
fromSeconds Float
duration = Int -> Interval
fromMicroseconds (Float -> Int
round (Float
1e6 Float -> Float -> Float
forall number. Num number => number -> number -> number
* Float
duration))

-- | Get the duration of an interval in milliseconds.
milliseconds :: Interval -> Float
milliseconds :: Interval -> Float
milliseconds Interval
interval = Float
1e-3 Float -> Float -> Float
forall number. Num number => number -> number -> number
* Int -> Float
toFloat (Interval -> Int
microseconds Interval
interval)

-- | Create an `Interval` lasting a certain number of milliseconds.
fromMilliseconds :: Float -> Interval
fromMilliseconds :: Float -> Interval
fromMilliseconds Float
duration = Int -> Interval
fromMicroseconds (Float -> Int
round (Float
1e3 Float -> Float -> Float
forall number. Num number => number -> number -> number
* Float
duration))