{-# OPTIONS_GHC -optc-DHS_CLOCK_HAVE_PROCESS_CPUTIME #-}
{-# OPTIONS_GHC -optc-DHS_CLOCK_HAVE_THREAD_CPUTIME #-}
{-# LINE 1 "System/Clock.hsc" #-}
-- | High-resolution, realtime clock and timer functions for Posix
--   systems. This module is being developed according to IEEE Std
--   1003.1-2008: <http://www.opengroup.org/onlinepubs/9699919799/>,
--   <http://www.opengroup.org/onlinepubs/9699919799/functions/clock_getres.html#>

{-# LANGUAGE CApiFFI #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-- To allow importing Data.Int and Data.Word indiscriminately on all platforms,
-- since we can't systematically predict what typedef's expand to.
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

module System.Clock
  ( Clock(..)
  , TimeSpec(..)
  , getTime
  , getRes
  , fromNanoSecs
  , toNanoSecs
  , diffTimeSpec
  , timeSpecAsNanoSecs
  , normalize
  , s2ns
  ) where

import Control.Applicative ((<$>), (<*>))
import Data.Int
import Data.Word
import Data.Ratio
import Data.Typeable (Typeable)
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import GHC.Generics (Generic)


{-# LINE 41 "System/Clock.hsc" #-}


{-# LINE 43 "System/Clock.hsc" #-}


{-# LINE 45 "System/Clock.hsc" #-}

{-# LINE 46 "System/Clock.hsc" #-}


{-# LINE 48 "System/Clock.hsc" #-}
import System.Posix.Types

{-# LINE 50 "System/Clock.hsc" #-}


{-# LINE 54 "System/Clock.hsc" #-}

-- | Clock types. A clock may be system-wide (that is, visible to all processes)
--   or per-process (measuring time that is meaningful only within a process).
--   All implementations shall support 'Realtime'.
data Clock

    -- | The identifier for the system-wide monotonic clock, which is defined as
    --   a clock measuring real time, whose value cannot be set via
    --   @clock_settime@ and which cannot have negative clock jumps. The maximum
    --   possible clock jump shall be implementation defined. For this clock,
    --   the value returned by 'getTime' represents the amount of time (in
    --   seconds and nanoseconds) since an unspecified point in the past (for
    --   example, system start-up time, or the Epoch). This point does not
    --   change after system start-up time. Note that the absolute value of the
    --   monotonic clock is meaningless (because its origin is arbitrary), and
    --   thus there is no need to set it. Furthermore, realtime applications can
    --   rely on the fact that the value of this clock is never set.
    --   (Identical to 'Boottime' since Linux 4.17, see https://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git/commit/?id=d6ed449afdb38f89a7b38ec50e367559e1b8f71f)
    --  @CLOCK_MONOTONIC@ (macOS - @SYSTEM_CLOCK@)
  = Monotonic

    -- | The identifier of the system-wide clock measuring real time. For this
    --   clock, the value returned by 'getTime' represents the amount of time (in
    --   seconds and nanoseconds) since the Epoch.
    -- @CLOCK_REALTIME@ (macOS - @CALENDAR_CLOCK@, Windows - @GetSystemTimeAsFileTime@)
  | Realtime


{-# LINE 82 "System/Clock.hsc" #-}
    -- | The identifier of the CPU-time clock associated with the calling
    --   process. For this clock, the value returned by 'getTime' represents the
    --   amount of execution time of the current process.
  | ProcessCPUTime

{-# LINE 87 "System/Clock.hsc" #-}


{-# LINE 89 "System/Clock.hsc" #-}
    -- | The identifier of the CPU-time clock associated with the calling OS
    --   thread. For this clock, the value returned by 'getTime' represents the
    --   amount of execution time of the current OS thread.
  | ThreadCPUTime

{-# LINE 94 "System/Clock.hsc" #-}


{-# LINE 96 "System/Clock.hsc" #-}
    -- | (since Linux 2.6.28, macOS 10.12)
    --   Similar to 'Monotonic', but provides access to a
    --   raw hardware-based time that is not subject to NTP
    --   adjustments or the incremental adjustments performed by
    --   adjtime(3).
    --   @CLOCK_MONOTONIC_RAW@ (Windows - @QueryPerformanceCounter@, @QueryPerformanceFrequency@)
  | MonotonicRaw

{-# LINE 104 "System/Clock.hsc" #-}


{-# LINE 106 "System/Clock.hsc" #-}
    -- | (since Linux 2.6.39; Linux-specific)
    --   Identical to `Monotonic`, except it also includes
    --   any time that the system is suspended. This allows
    --   applications to get a suspend-aware monotonic clock
    --   without having to deal with the complications of 'Realtime',
    --   which may have discontinuities if the time is changed
    --   using settimeofday(2).
    --   (since Linux 4.17; identical to 'Monotonic')
    --   @CLOCK_BOOTTIME@
  | Boottime

{-# LINE 117 "System/Clock.hsc" #-}


{-# LINE 119 "System/Clock.hsc" #-}
    -- | (since Linux 2.6.32; Linux-specific)
    --   A faster but less precise version of 'Monotonic'.
    --   Use when you need very fast, but not fine-grained timestamps.
    --   @CLOCK_MONOTONIC_COARSE@
  | MonotonicCoarse

{-# LINE 125 "System/Clock.hsc" #-}


{-# LINE 127 "System/Clock.hsc" #-}
    -- | (since Linux 2.6.32; Linux-specific)
    --   A faster but less precise version of 'Realtime'.
    --   Use when you need very fast, but not fine-grained timestamps.
    --   @CLOCK_REALTIME_COARSE@
  | RealtimeCoarse

{-# LINE 133 "System/Clock.hsc" #-}

  deriving (Clock -> Clock -> Bool
(Clock -> Clock -> Bool) -> (Clock -> Clock -> Bool) -> Eq Clock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Clock -> Clock -> Bool
== :: Clock -> Clock -> Bool
$c/= :: Clock -> Clock -> Bool
/= :: Clock -> Clock -> Bool
Eq, Int -> Clock
Clock -> Int
Clock -> [Clock]
Clock -> Clock
Clock -> Clock -> [Clock]
Clock -> Clock -> Clock -> [Clock]
(Clock -> Clock)
-> (Clock -> Clock)
-> (Int -> Clock)
-> (Clock -> Int)
-> (Clock -> [Clock])
-> (Clock -> Clock -> [Clock])
-> (Clock -> Clock -> [Clock])
-> (Clock -> Clock -> Clock -> [Clock])
-> Enum Clock
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Clock -> Clock
succ :: Clock -> Clock
$cpred :: Clock -> Clock
pred :: Clock -> Clock
$ctoEnum :: Int -> Clock
toEnum :: Int -> Clock
$cfromEnum :: Clock -> Int
fromEnum :: Clock -> Int
$cenumFrom :: Clock -> [Clock]
enumFrom :: Clock -> [Clock]
$cenumFromThen :: Clock -> Clock -> [Clock]
enumFromThen :: Clock -> Clock -> [Clock]
$cenumFromTo :: Clock -> Clock -> [Clock]
enumFromTo :: Clock -> Clock -> [Clock]
$cenumFromThenTo :: Clock -> Clock -> Clock -> [Clock]
enumFromThenTo :: Clock -> Clock -> Clock -> [Clock]
Enum, (forall x. Clock -> Rep Clock x)
-> (forall x. Rep Clock x -> Clock) -> Generic Clock
forall x. Rep Clock x -> Clock
forall x. Clock -> Rep Clock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Clock -> Rep Clock x
from :: forall x. Clock -> Rep Clock x
$cto :: forall x. Rep Clock x -> Clock
to :: forall x. Rep Clock x -> Clock
Generic, ReadPrec [Clock]
ReadPrec Clock
Int -> ReadS Clock
ReadS [Clock]
(Int -> ReadS Clock)
-> ReadS [Clock]
-> ReadPrec Clock
-> ReadPrec [Clock]
-> Read Clock
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Clock
readsPrec :: Int -> ReadS Clock
$creadList :: ReadS [Clock]
readList :: ReadS [Clock]
$creadPrec :: ReadPrec Clock
readPrec :: ReadPrec Clock
$creadListPrec :: ReadPrec [Clock]
readListPrec :: ReadPrec [Clock]
Read, Int -> Clock -> ShowS
[Clock] -> ShowS
Clock -> String
(Int -> Clock -> ShowS)
-> (Clock -> String) -> ([Clock] -> ShowS) -> Show Clock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Clock -> ShowS
showsPrec :: Int -> Clock -> ShowS
$cshow :: Clock -> String
show :: Clock -> String
$cshowList :: [Clock] -> ShowS
showList :: [Clock] -> ShowS
Show, Typeable)


{-# LINE 146 "System/Clock.hsc" #-}

{-# LINE 147 "System/Clock.hsc" #-}
type ClockId = CClockId

{-# LINE 151 "System/Clock.hsc" #-}

foreign import ccall unsafe clock_gettime :: ClockId -> Ptr TimeSpec -> IO CInt
foreign import ccall unsafe clock_getres  :: ClockId -> Ptr TimeSpec -> IO CInt

foreign import capi unsafe "time.h value CLOCK_MONOTONIC" clock_MONOTONIC :: ClockId
foreign import capi unsafe "time.h value CLOCK_REALTIME" clock_REALTIME :: ClockId

{-# LINE 158 "System/Clock.hsc" #-}
foreign import capi unsafe "time.h value CLOCK_PROCESS_CPUTIME_ID" clock_PROCESS_CPUTIME_ID :: ClockId

{-# LINE 160 "System/Clock.hsc" #-}

{-# LINE 161 "System/Clock.hsc" #-}
foreign import capi unsafe "time.h value CLOCK_THREAD_CPUTIME_ID" clock_THREAD_CPUTIME_ID :: ClockId

{-# LINE 163 "System/Clock.hsc" #-}

{-# LINE 164 "System/Clock.hsc" #-}
foreign import capi unsafe "time.h value CLOCK_MONOTONIC_RAW" clock_MONOTONIC_RAW :: ClockId

{-# LINE 166 "System/Clock.hsc" #-}

{-# LINE 167 "System/Clock.hsc" #-}
foreign import capi unsafe "time.h value CLOCK_BOOTTIME" clock_BOOTTIME :: ClockId

{-# LINE 169 "System/Clock.hsc" #-}

{-# LINE 170 "System/Clock.hsc" #-}
foreign import capi unsafe "time.h value CLOCK_MONOTONIC_COARSE" clock_MONOTONIC_COARSE :: ClockId

{-# LINE 172 "System/Clock.hsc" #-}

{-# LINE 173 "System/Clock.hsc" #-}
foreign import capi unsafe "time.h value CLOCK_REALTIME_COARSE" clock_REALTIME_COARSE :: ClockId

{-# LINE 175 "System/Clock.hsc" #-}

{-# LINE 176 "System/Clock.hsc" #-}


{-# LINE 178 "System/Clock.hsc" #-}
clockToConst :: Clock -> ClockId
clockToConst :: Clock -> ClockId
clockToConst Clock
Monotonic = ClockId
clock_MONOTONIC
clockToConst  Clock
Realtime = ClockId
clock_REALTIME

{-# LINE 182 "System/Clock.hsc" #-}
clockToConst ProcessCPUTime = clock_PROCESS_CPUTIME_ID

{-# LINE 184 "System/Clock.hsc" #-}

{-# LINE 185 "System/Clock.hsc" #-}
clockToConst  ThreadCPUTime = clock_THREAD_CPUTIME_ID

{-# LINE 187 "System/Clock.hsc" #-}

{-# LINE 188 "System/Clock.hsc" #-}
clockToConst    MonotonicRaw = clock_MONOTONIC_RAW

{-# LINE 190 "System/Clock.hsc" #-}

{-# LINE 191 "System/Clock.hsc" #-}
clockToConst        Boottime = clock_BOOTTIME

{-# LINE 193 "System/Clock.hsc" #-}

{-# LINE 194 "System/Clock.hsc" #-}
clockToConst MonotonicCoarse = clock_MONOTONIC_COARSE

{-# LINE 196 "System/Clock.hsc" #-}

{-# LINE 197 "System/Clock.hsc" #-}
clockToConst  RealtimeCoarse = clock_REALTIME_COARSE

{-# LINE 199 "System/Clock.hsc" #-}

{-# LINE 200 "System/Clock.hsc" #-}

allocaAndPeek :: Storable a => (Ptr a -> IO ()) -> IO a
allocaAndPeek :: forall a. Storable a => (Ptr a -> IO ()) -> IO a
allocaAndPeek Ptr a -> IO ()
f = (Ptr a -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> IO ()
f Ptr a
ptr IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr

-- | The 'getTime' function shall return the current value for the
--   specified clock.
getTime :: Clock -> IO TimeSpec

-- | 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 TimeSpec


{-# LINE 219 "System/Clock.hsc" #-}
getTime :: Clock -> IO TimeSpec
getTime Clock
clk = (Ptr TimeSpec -> IO ()) -> IO TimeSpec
forall a. Storable a => (Ptr a -> IO ()) -> IO a
allocaAndPeek ((Ptr TimeSpec -> IO ()) -> IO TimeSpec)
-> (Ptr TimeSpec -> IO ()) -> IO TimeSpec
forall a b. (a -> b) -> a -> b
$! String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"clock_gettime" (IO CInt -> IO ())
-> (Ptr TimeSpec -> IO CInt) -> Ptr TimeSpec -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockId -> Ptr TimeSpec -> IO CInt
clock_gettime (Clock -> ClockId
clockToConst Clock
clk)

{-# LINE 221 "System/Clock.hsc" #-}


{-# LINE 228 "System/Clock.hsc" #-}
getRes :: Clock -> IO TimeSpec
getRes Clock
clk = (Ptr TimeSpec -> IO ()) -> IO TimeSpec
forall a. Storable a => (Ptr a -> IO ()) -> IO a
allocaAndPeek ((Ptr TimeSpec -> IO ()) -> IO TimeSpec)
-> (Ptr TimeSpec -> IO ()) -> IO TimeSpec
forall a b. (a -> b) -> a -> b
$! String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"clock_getres" (IO CInt -> IO ())
-> (Ptr TimeSpec -> IO CInt) -> Ptr TimeSpec -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockId -> Ptr TimeSpec -> IO CInt
clock_getres (Clock -> ClockId
clockToConst Clock
clk)

{-# LINE 230 "System/Clock.hsc" #-}

-- | TimeSpec structure
data TimeSpec = TimeSpec
  { TimeSpec -> Int64
sec  :: {-# UNPACK #-} !Int64 -- ^ seconds
  , TimeSpec -> Int64
nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds
  } deriving ((forall x. TimeSpec -> Rep TimeSpec x)
-> (forall x. Rep TimeSpec x -> TimeSpec) -> Generic TimeSpec
forall x. Rep TimeSpec x -> TimeSpec
forall x. TimeSpec -> Rep TimeSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeSpec -> Rep TimeSpec x
from :: forall x. TimeSpec -> Rep TimeSpec x
$cto :: forall x. Rep TimeSpec x -> TimeSpec
to :: forall x. Rep TimeSpec x -> TimeSpec
Generic, ReadPrec [TimeSpec]
ReadPrec TimeSpec
Int -> ReadS TimeSpec
ReadS [TimeSpec]
(Int -> ReadS TimeSpec)
-> ReadS [TimeSpec]
-> ReadPrec TimeSpec
-> ReadPrec [TimeSpec]
-> Read TimeSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TimeSpec
readsPrec :: Int -> ReadS TimeSpec
$creadList :: ReadS [TimeSpec]
readList :: ReadS [TimeSpec]
$creadPrec :: ReadPrec TimeSpec
readPrec :: ReadPrec TimeSpec
$creadListPrec :: ReadPrec [TimeSpec]
readListPrec :: ReadPrec [TimeSpec]
Read, Int -> TimeSpec -> ShowS
[TimeSpec] -> ShowS
TimeSpec -> String
(Int -> TimeSpec -> ShowS)
-> (TimeSpec -> String) -> ([TimeSpec] -> ShowS) -> Show TimeSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeSpec -> ShowS
showsPrec :: Int -> TimeSpec -> ShowS
$cshow :: TimeSpec -> String
show :: TimeSpec -> String
$cshowList :: [TimeSpec] -> ShowS
showList :: [TimeSpec] -> ShowS
Show, Typeable)


{-# LINE 249 "System/Clock.hsc" #-}
instance Storable TimeSpec where
  sizeOf :: TimeSpec -> Int
sizeOf TimeSpec
_ = (Int
16)
{-# LINE 251 "System/Clock.hsc" #-}
  alignment _ = 8
{-# LINE 252 "System/Clock.hsc" #-}
  poke ptr ts = do
      let xs :: Int64 = fromIntegral $ sec ts
{-# LINE 254 "System/Clock.hsc" #-}
          xn :: Int64 = fromIntegral $ nsec ts
{-# LINE 255 "System/Clock.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (xs)
{-# LINE 256 "System/Clock.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (xn)
{-# LINE 257 "System/Clock.hsc" #-}
  peek ptr = do
      xs :: Int64 <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 259 "System/Clock.hsc" #-}
      xn :: Int64 <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 260 "System/Clock.hsc" #-}
      return $ TimeSpec (fromIntegral xs) (fromIntegral xn)

{-# LINE 262 "System/Clock.hsc" #-}

s2ns :: Num a => a
s2ns :: forall a. Num a => a
s2ns = a
10a -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
9

normalize :: TimeSpec -> TimeSpec
normalize :: TimeSpec -> TimeSpec
normalize (TimeSpec Int64
xs Int64
xn) | Int64
xn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 Bool -> Bool -> Bool
|| Int64
xn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
forall a. Num a => a
s2ns = Int64 -> Int64 -> TimeSpec
TimeSpec (Int64
xs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
q)  Int64
r
                           | Bool
otherwise            = Int64 -> Int64 -> TimeSpec
TimeSpec  Int64
xs      Int64
xn
                             where (Int64
q, Int64
r) = Int64
xn Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
forall a. Num a => a
s2ns

instance Num TimeSpec where
  (TimeSpec Int64
xs Int64
xn) + :: TimeSpec -> TimeSpec -> TimeSpec
+ (TimeSpec Int64
ys Int64
yn) = TimeSpec -> TimeSpec
normalize (TimeSpec -> TimeSpec) -> TimeSpec -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Int64 -> Int64 -> TimeSpec
TimeSpec (Int64
xs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
ys) (Int64
xn Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
yn)
  (TimeSpec Int64
xs Int64
xn) - :: TimeSpec -> TimeSpec -> TimeSpec
- (TimeSpec Int64
ys Int64
yn) = TimeSpec -> TimeSpec
normalize (TimeSpec -> TimeSpec) -> TimeSpec -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Int64 -> Int64 -> TimeSpec
TimeSpec (Int64
xs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
ys) (Int64
xn Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
yn)
  (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
xs Int64
xn) * :: TimeSpec -> TimeSpec -> TimeSpec
* (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
ys Int64
yn) = TimeSpec -> TimeSpec
normalize (TimeSpec -> TimeSpec) -> TimeSpec -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Int64 -> Int64 -> TimeSpec
TimeSpec (Int64
forall a. Num a => a
s2nsInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
xsInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
ysInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+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
ys) (Int64
xnInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
yn)
  negate :: TimeSpec -> TimeSpec
negate (TimeSpec Int64
xs Int64
xn) = TimeSpec -> TimeSpec
normalize (TimeSpec -> TimeSpec) -> TimeSpec -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Int64 -> Int64 -> TimeSpec
TimeSpec (Int64 -> Int64
forall a. Num a => a -> a
negate Int64
xs) (Int64 -> Int64
forall a. Num a => a -> a
negate Int64
xn)
  abs :: TimeSpec -> TimeSpec
abs    (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
xs Int64
xn) | Int64
xs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0   = TimeSpec -> TimeSpec
normalize (TimeSpec -> TimeSpec) -> TimeSpec -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Int64 -> Int64 -> TimeSpec
TimeSpec Int64
0 Int64
xn
                                       | Bool
otherwise = TimeSpec -> TimeSpec
normalize (TimeSpec -> TimeSpec) -> TimeSpec -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Int64 -> Int64 -> TimeSpec
TimeSpec (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
xs) (Int64 -> Int64
forall a. Num a => a -> a
signum Int64
xs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
xn)
  signum :: TimeSpec -> TimeSpec
signum (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
xs Int64
xn) | Int64
xs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0   = Int64 -> Int64 -> TimeSpec
TimeSpec Int64
0 (Int64 -> Int64
forall a. Num a => a -> a
signum Int64
xn)
                                       | Bool
otherwise = Int64 -> Int64 -> TimeSpec
TimeSpec Int64
0 (Int64 -> Int64
forall a. Num a => a -> a
signum Int64
xs)
  fromInteger :: Integer -> TimeSpec
fromInteger Integer
x = Int64 -> Int64 -> TimeSpec
TimeSpec (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
q) (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
r) where (Integer
q, Integer
r) = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
forall a. Num a => a
s2ns

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

instance Real TimeSpec where
  toRational :: TimeSpec -> Rational
toRational 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
1

instance Integral TimeSpec where
  toInteger :: TimeSpec -> Integer
toInteger = TimeSpec -> Integer
toNanoSecs
  quot :: TimeSpec -> TimeSpec -> TimeSpec
quot (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t1) (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t2) = Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
t1 Integer
t2
  rem :: TimeSpec -> TimeSpec -> TimeSpec
rem (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t1) (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t2) = Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Integer
t1 Integer
t2
  div :: TimeSpec -> TimeSpec -> TimeSpec
div (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t1) (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t2) = Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
t1 Integer
t2
  mod :: TimeSpec -> TimeSpec -> TimeSpec
mod (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t1) (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t2) = Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
t1 Integer
t2
  divMod :: TimeSpec -> TimeSpec -> (TimeSpec, TimeSpec)
divMod (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t1) (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t2) =
    let (Integer
q,Integer
r)=Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
t1 Integer
t2 in (Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer
q, Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer
r)
  quotRem :: TimeSpec -> TimeSpec -> (TimeSpec, TimeSpec)
quotRem (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t1) (TimeSpec -> Integer
forall a. Integral a => a -> Integer
toInteger-> Integer
t2) =
    let (Integer
q,Integer
r)=Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
t1 Integer
t2 in (Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer
q, Integer -> TimeSpec
forall a. Num a => Integer -> a
fromInteger (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$! Integer
r)

instance Eq TimeSpec where
  (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
xs Int64
xn) == :: TimeSpec -> TimeSpec -> Bool
== (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
ys Int64
yn) | Bool
True Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
es = Int64
xn Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
yn
                                                                 | Bool
otherwise  = Bool
es
                                                                   where   es :: Bool
es = Int64
xs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
ys

instance Ord TimeSpec where
  compare :: TimeSpec -> TimeSpec -> Ordering
compare (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
xs Int64
xn) (TimeSpec -> TimeSpec
normalize -> TimeSpec Int64
ys Int64
yn) | Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==  Ordering
os = Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
xn Int64
yn
                                                                      | Bool
otherwise = Ordering
os
                                                                        where  os :: Ordering
os = Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
xs Int64
ys

instance Bounded TimeSpec where
  minBound :: TimeSpec
minBound = Int64 -> Int64 -> TimeSpec
TimeSpec Int64
forall a. Bounded a => a
minBound Int64
0
  maxBound :: TimeSpec
maxBound = Int64 -> Int64 -> TimeSpec
TimeSpec Int64
forall a. Bounded a => a
maxBound (Int64
forall a. Num a => a
s2nsInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)

-- | TimeSpec from nano seconds.
fromNanoSecs :: Integer -> TimeSpec
fromNanoSecs :: Integer -> TimeSpec
fromNanoSecs Integer
x = Int64 -> Int64 -> TimeSpec
TimeSpec (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger  Integer
q) (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger  Integer
r) where (Integer
q, Integer
r) = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
forall a. Num a => a
s2ns


-- | TimeSpec to nano seconds.
toNanoSecs :: TimeSpec -> Integer
toNanoSecs :: TimeSpec -> Integer
toNanoSecs   (TimeSpec  (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
s) (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
n)) = Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
forall a. Num a => a
s2ns Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n

-- | Compute the absolute difference.
diffTimeSpec :: TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec :: TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
ts1 TimeSpec
ts2 = TimeSpec -> TimeSpec
forall a. Num a => a -> a
abs (TimeSpec
ts1 TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
- TimeSpec
ts2)

{-# DEPRECATED timeSpecAsNanoSecs "Use toNanoSecs instead! Replaced timeSpecAsNanoSecs with the same signature TimeSpec -> Integer" #-}
-- | TimeSpec as nano seconds.
timeSpecAsNanoSecs :: TimeSpec -> Integer
timeSpecAsNanoSecs :: TimeSpec -> Integer
timeSpecAsNanoSecs   (TimeSpec Int64
s Int64
n) = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
forall a. Num a => a
s2ns Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n