{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module System.Clock.Seconds
  ( Clock(..)
  , Seconds(..)
  , getTime
  , getRes
  , fromNanoSecs
  , toNanoSecs
  , diffTimeSpec
  ) where

import Data.Coerce
import Data.Ratio
import Data.Typeable (Typeable)
import Foreign.Storable
import GHC.Generics (Generic)

import System.Clock(TimeSpec(..), Clock, s2ns, normalize)
import qualified System.Clock as C

newtype Seconds = Seconds { Seconds -> TimeSpec
toTimeSpec :: TimeSpec }
 deriving ((forall x. Seconds -> Rep Seconds x)
-> (forall x. Rep Seconds x -> Seconds) -> Generic Seconds
forall x. Rep Seconds x -> Seconds
forall x. Seconds -> Rep Seconds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Seconds x -> Seconds
$cfrom :: forall x. Seconds -> Rep Seconds x
Generic, 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, 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, Typeable, 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, Ptr b -> Int -> IO Seconds
Ptr b -> Int -> Seconds -> IO ()
Ptr Seconds -> IO Seconds
Ptr Seconds -> Int -> IO Seconds
Ptr Seconds -> Int -> Seconds -> IO ()
Ptr Seconds -> Seconds -> IO ()
Seconds -> Int
(Seconds -> Int)
-> (Seconds -> Int)
-> (Ptr Seconds -> Int -> IO Seconds)
-> (Ptr Seconds -> Int -> Seconds -> IO ())
-> (forall b. Ptr b -> Int -> IO Seconds)
-> (forall b. Ptr b -> Int -> Seconds -> IO ())
-> (Ptr Seconds -> IO Seconds)
-> (Ptr Seconds -> Seconds -> IO ())
-> Storable Seconds
forall b. Ptr b -> Int -> IO Seconds
forall b. Ptr b -> Int -> Seconds -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Seconds -> Seconds -> IO ()
$cpoke :: Ptr Seconds -> Seconds -> IO ()
peek :: Ptr Seconds -> IO Seconds
$cpeek :: Ptr Seconds -> IO Seconds
pokeByteOff :: Ptr b -> Int -> Seconds -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Seconds -> IO ()
peekByteOff :: Ptr b -> Int -> IO Seconds
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Seconds
pokeElemOff :: Ptr Seconds -> Int -> Seconds -> IO ()
$cpokeElemOff :: Ptr Seconds -> Int -> Seconds -> IO ()
peekElemOff :: Ptr Seconds -> Int -> IO Seconds
$cpeekElemOff :: Ptr Seconds -> Int -> IO Seconds
alignment :: Seconds -> Int
$calignment :: Seconds -> Int
sizeOf :: Seconds -> Int
$csizeOf :: Seconds -> Int
Storable, Seconds
Seconds -> Seconds -> Bounded Seconds
forall a. a -> a -> Bounded a
maxBound :: Seconds
$cmaxBound :: Seconds
minBound :: Seconds
$cminBound :: Seconds
Bounded)

instance Num Seconds where
  fromInteger :: Integer -> Seconds
fromInteger Integer
n = TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds) -> TimeSpec -> Seconds
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> TimeSpec
TimeSpec (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
n) Int64
0
  Seconds (TimeSpec Int64
xs Int64
xn) * :: Seconds -> Seconds -> Seconds
* Seconds (TimeSpec Int64
ys Int64
yn) =
    TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds) -> TimeSpec -> Seconds
forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec
normalize (TimeSpec -> TimeSpec) -> TimeSpec -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Int64 -> Int64 -> TimeSpec
TimeSpec (Int64
xsInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
ys) (Int64
xsInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
ynInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
xnInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
ysInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+((Int64
xnInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
yn) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
forall a. Num a => a
s2ns))
  + :: Seconds -> Seconds -> Seconds
(+) = (TimeSpec -> TimeSpec -> TimeSpec) -> Seconds -> Seconds -> Seconds
coerce (TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
(+) :: TimeSpec -> TimeSpec -> TimeSpec)
  (-) = (TimeSpec -> TimeSpec -> TimeSpec) -> Seconds -> Seconds -> Seconds
coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec)
  negate :: Seconds -> Seconds
negate = (TimeSpec -> TimeSpec) -> Seconds -> Seconds
coerce (TimeSpec -> TimeSpec
forall a. Num a => a -> a
negate :: TimeSpec -> TimeSpec)
  abs :: Seconds -> Seconds
abs = (TimeSpec -> TimeSpec) -> Seconds -> Seconds
coerce (TimeSpec -> TimeSpec
forall a. Num a => a -> a
abs :: TimeSpec -> TimeSpec)
  signum :: Seconds -> Seconds
signum (Seconds TimeSpec
a) = case TimeSpec -> TimeSpec
forall a. Num a => a -> a
signum TimeSpec
a of
    TimeSpec
1 -> Seconds
1
    (-1) -> (-Seconds
1)
    TimeSpec
_ -> Seconds
0

instance Enum Seconds where
  succ :: Seconds -> Seconds
succ Seconds
x = Seconds
x Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
+ Seconds
1
  pred :: Seconds -> Seconds
pred Seconds
x = Seconds
x Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
1
  toEnum :: Int -> Seconds
toEnum Int
x = TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds) -> TimeSpec -> Seconds
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> TimeSpec
TimeSpec (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) Int64
0
  fromEnum :: Seconds -> Int
fromEnum (Seconds (TimeSpec Int64
s Int64
_)) = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum Int64
s

instance Real Seconds where
  toRational :: Seconds -> Rational
toRational (Seconds TimeSpec
x) = TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger TimeSpec
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
forall a. Num a => a
s2ns

instance Fractional Seconds where
  fromRational :: Rational -> Seconds
fromRational Rational
x = TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds)
-> (Integer -> TimeSpec) -> Integer -> Seconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> Seconds) -> Integer -> Seconds
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
forall a. Num a => a
s2ns)
  Seconds TimeSpec
a / :: Seconds -> Seconds -> Seconds
/ Seconds TimeSpec
b = TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds) -> TimeSpec -> Seconds
forall a b. (a -> b) -> a -> b
$ TimeSpec
a TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
* TimeSpec
forall a. Num a => a
s2ns TimeSpec -> TimeSpec -> TimeSpec
forall a. Integral a => a -> a -> a
`div` TimeSpec
b
  recip :: Seconds -> Seconds
recip (Seconds TimeSpec
a) = TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds) -> TimeSpec -> Seconds
forall a b. (a -> b) -> a -> b
$ TimeSpec
forall a. Num a => a
s2ns TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
* TimeSpec
forall a. Num a => a
s2ns TimeSpec -> TimeSpec -> TimeSpec
forall a. Integral a => a -> a -> a
`div` TimeSpec
a

instance RealFrac Seconds where
  properFraction :: Seconds -> (b, Seconds)
properFraction (Seconds (TimeSpec Int64
s Int64
ns))
    | Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 = (Int64 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s, TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds) -> TimeSpec -> Seconds
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> TimeSpec
TimeSpec Int64
0 Int64
ns)
    | Bool
otherwise = (Int64 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
sInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1), TimeSpec -> Seconds
Seconds (TimeSpec -> Seconds) -> TimeSpec -> Seconds
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> TimeSpec
TimeSpec (-Int64
1) Int64
ns)

-- | The 'getTime' function shall return the current value for the
--   specified clock.
getTime :: Clock -> IO Seconds
getTime :: Clock -> IO Seconds
getTime = (Clock -> IO TimeSpec) -> Clock -> IO Seconds
coerce Clock -> IO TimeSpec
C.getTime

-- | The 'getRes' function shall return the resolution of any clock.
--   Clock resolutions are implementation-defined and cannot be set
--   by a process.
getRes :: Clock -> IO Seconds
getRes :: Clock -> IO Seconds
getRes = (Clock -> IO TimeSpec) -> Clock -> IO Seconds
coerce Clock -> IO TimeSpec
C.getRes

-- | Seconds from nano seconds.
fromNanoSecs :: Integer -> Seconds
fromNanoSecs :: Integer -> Seconds
fromNanoSecs = (Integer -> TimeSpec) -> Integer -> Seconds
coerce Integer -> TimeSpec
C.fromNanoSecs

-- | Seconds to nano seconds.
toNanoSecs :: Seconds -> Integer
toNanoSecs :: Seconds -> Integer
toNanoSecs = (TimeSpec -> Integer) -> Seconds -> Integer
coerce TimeSpec -> Integer
C.toNanoSecs

-- | Compute the absolute difference.
diffTimeSpec :: Seconds -> Seconds -> Seconds
diffTimeSpec :: Seconds -> Seconds -> Seconds
diffTimeSpec = (TimeSpec -> TimeSpec -> TimeSpec) -> Seconds -> Seconds -> Seconds
coerce TimeSpec -> TimeSpec -> TimeSpec
C.diffTimeSpec