{-# LINE 1 "src/System/Posix/Timer.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "src/System/Posix/Timer.hsc" #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | POSIX clocks and timers.
module System.Posix.Timer (
    -- * Clocks
    Clock(..),
    monotonicClock,
    realtimeClock,
    processTimeClock,
    threadTimeClock,

    getProcClock,
    getClockResolution,
    getClockTime,
    setClockTime,
    clockSleep,
    clockSleepAbs,

    -- * Timers
    TimeSpec,
    timeSpecSeconds,
    timeSpecNanoseconds,
    mkTimeSpec,
    timeSpecV,
    ITimerSpec(..),

    Timer,
    createTimer,
    configureTimer,
    timerTimeLeft,
    timerOverrunCnt,
    destroyTimer
  ) where

import Data.Int
import Data.Word
import Foreign.Storable (Storable(..))
import Foreign.Ptr (Ptr, WordPtr, nullPtr, castPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Utils (with)
import Foreign.C.Types (CInt, CULong, CTime)
import Foreign.C.Error (getErrno, eINTR, throwErrno, throwErrnoIfMinus1,
                        throwErrnoIfMinus1_)
import System.Posix.Types (ProcessID)
import System.Posix.Signals (Signal)


{-# LINE 49 "src/System/Posix/Timer.hsc" #-}

{-# LINE 50 "src/System/Posix/Timer.hsc" #-}

{-# LINE 51 "src/System/Posix/Timer.hsc" #-}

nsPerSecond :: Num a => a
nsPerSecond = 1000000000

-- | Mirrors /clockid_t/.
newtype Clock = Clock Int32 deriving (Eq, Ord, Show, Storable)
{-# LINE 57 "src/System/Posix/Timer.hsc" #-}

monotonicClock  :: Clock
monotonicClock  = Clock 1
realtimeClock  :: Clock
realtimeClock  = Clock 0
processTimeClock  :: Clock
processTimeClock  = Clock 2
threadTimeClock  :: Clock
threadTimeClock  = Clock 3

{-# LINE 64 "src/System/Posix/Timer.hsc" #-}

-- | Mirrors /struct timespec/.
data TimeSpec = TimeSpec { timeSpecSeconds :: CTime
                         , timeSpecNanoseconds :: CULong
                         } deriving (Eq, Show)

-- | Create a 'TimeSpec' from amounts of seconds and nanoseconds.
mkTimeSpec :: CTime -> CULong -> TimeSpec
mkTimeSpec seconds nanoseconds =
  case nanoseconds of
    ns | ns >= nsPerSecond ->
      TimeSpec (seconds + (fromIntegral q)) r
        where (q, r) = ns `quotRem` nsPerSecond 
    _ -> TimeSpec seconds nanoseconds

-- | Convert a 'TimeSpec' to a pair of its components.
--   Useful as a view pattern.
timeSpecV :: TimeSpec -> (CTime, CULong)
timeSpecV (TimeSpec s ns) = (s, ns)

instance Ord TimeSpec where
  (TimeSpec s1 ns1) `compare` (TimeSpec s2 ns2) = 
    case s1 `compare` s2 of
      EQ -> ns1 `compare` ns2
      x -> x

instance Bounded TimeSpec where
  minBound = TimeSpec (fromIntegral (minBound :: Int32)) 0
{-# LINE 92 "src/System/Posix/Timer.hsc" #-}
  maxBound = TimeSpec (fromIntegral (maxBound :: Int32))
{-# LINE 93 "src/System/Posix/Timer.hsc" #-}
                      (nsPerSecond - 1)

instance Num TimeSpec where
  (TimeSpec s1 ns1) * (TimeSpec s2 ns2) =
    mkTimeSpec (s1 * s2 * nsPerSecond +
                s1 * (fromIntegral ns2) + s2 * (fromIntegral ns1) +
                (fromIntegral q)) $ fromIntegral r
      where (q, r) = ((fromIntegral ns1 :: Word64) *
                      (fromIntegral ns2 :: Word64)) `quotRem` nsPerSecond
  (TimeSpec s1 ns1) + (TimeSpec s2 ns2) = mkTimeSpec (s1 + s2) (ns1 + ns2)
  (TimeSpec s1 ns1) - (TimeSpec s2 ns2) =
    if ns1 < ns2 then TimeSpec (s1 - s2 - 1) (nsPerSecond - ns2 + ns1)
                 else TimeSpec (s1 - s2) (ns1 - ns2)
  negate (TimeSpec s ns) = mkTimeSpec ((-s) - 1) (nsPerSecond - ns)
  abs ts@(TimeSpec s _) = if s >= 0 then ts else negate ts
  signum (TimeSpec s _) =
    TimeSpec 0 (if s < 0 then -1 else (if s == 0 then 0 else nsPerSecond -1))
  fromInteger i = TimeSpec (fromInteger s) (fromInteger ns)
                    where (s, ns) = i `divMod` nsPerSecond


{-# LINE 114 "src/System/Posix/Timer.hsc" #-}

instance Storable TimeSpec where
  alignment _ = 4
{-# LINE 117 "src/System/Posix/Timer.hsc" #-}
  sizeOf _ = (8)
{-# LINE 118 "src/System/Posix/Timer.hsc" #-}
  peek p = do
    seconds <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 120 "src/System/Posix/Timer.hsc" #-}
    nanoseconds <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 121 "src/System/Posix/Timer.hsc" #-}
    return $ TimeSpec seconds nanoseconds
  poke p (TimeSpec seconds nanoseconds) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p seconds
{-# LINE 124 "src/System/Posix/Timer.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) p nanoseconds
{-# LINE 125 "src/System/Posix/Timer.hsc" #-}

-- | Mirrors /struct itimerspec/.
data ITimerSpec = ITimerSpec { iTimerSpecInterval :: !TimeSpec
                             , iTimerSpecValue :: !TimeSpec
                             } deriving (Eq, Show)

instance Storable ITimerSpec where
  alignment _ = 4
{-# LINE 133 "src/System/Posix/Timer.hsc" #-}
  sizeOf _ = (16)
{-# LINE 134 "src/System/Posix/Timer.hsc" #-}
  peek p = do
    interval <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 136 "src/System/Posix/Timer.hsc" #-}
    value <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 137 "src/System/Posix/Timer.hsc" #-}
    return $ ITimerSpec interval value
  poke p (ITimerSpec interval value) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p interval
{-# LINE 140 "src/System/Posix/Timer.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) p value
{-# LINE 141 "src/System/Posix/Timer.hsc" #-}

-- | Mirrors /timer_t/.
newtype Timer = Timer Word32 deriving (Eq, Ord, Show, Storable)
{-# LINE 144 "src/System/Posix/Timer.hsc" #-}

-- | Get the CPU-time clock of the given process.
--   See /clock_getcpuclockid(3)/.
getProcClock :: ProcessID -> IO Clock
getProcClock pid = do
  alloca $ \p -> do
    throwErrnoIfMinus1_ "getProcClock" $ c_clock_getcpuclockid pid p
    peek p

-- | Get the clock resolution. See /clock_getres(3)/.
getClockResolution :: Clock -> IO TimeSpec
getClockResolution clock = do
  alloca $ \p -> do
    throwErrnoIfMinus1_ "getClockResolution" $ c_clock_getres clock p
    peek p

-- | Get the clock time. See /clock_gettime(3)/.
getClockTime :: Clock -> IO TimeSpec
getClockTime clock = do
  alloca $ \p -> do
    throwErrnoIfMinus1_ "getClockTime" $ c_clock_gettime clock p
    peek p

-- | Set the clock time. See /clock_settime(3)/.
setClockTime :: Clock -> TimeSpec -> IO ()
setClockTime clock ts =
  with ts $ throwErrnoIfMinus1_ "setClockTime" . c_clock_settime clock

-- | Sleep for the specified duration. When interrupted by a signal, returns
--   the amount of time left to sleep. See /clock_nanosleep(3)/.
clockSleep :: Clock -> TimeSpec -> IO TimeSpec
clockSleep clock ts =
  with ts $ \pTs ->
    alloca $ \pLeft -> do 
      result <- c_clock_nanosleep clock 0 pTs pLeft
      if result == 0
        then return 0
        else do
          errno <- getErrno
          if errno == eINTR
            then peek pLeft
            else throwErrno "clockSleep"

-- | Sleep until the clock time reaches the specified value.
--   See /clock_nanosleep(3)/.
clockSleepAbs :: Clock -> TimeSpec -> IO ()
clockSleepAbs clock ts =
  with ts $ \p ->
    throwErrnoIfMinus1_ "clockSleepAbs" $
      c_clock_nanosleep clock 1 p nullPtr
{-# LINE 194 "src/System/Posix/Timer.hsc" #-}

-- | Create a timer. See /timer_create(3)/.
createTimer :: Clock
            -> Maybe (Signal, WordPtr) -- ^ Optional signal to raise on timer
                                       --   expirations and value of
                                       --   /siginfo.si_value/.
            -> IO Timer
createTimer clock sigEvent = do
  alloca $ \pTimer -> do
    throwErrnoIfMinus1_ "createTimer" $
      case sigEvent of
        Just (signal, ud) -> do
          allocaBytes (64) $ \pEv -> do
{-# LINE 207 "src/System/Posix/Timer.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 8) pEv
{-# LINE 208 "src/System/Posix/Timer.hsc" #-}
              (0 :: CInt)
{-# LINE 209 "src/System/Posix/Timer.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 4) pEv signal
{-# LINE 210 "src/System/Posix/Timer.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 0) pEv ud
{-# LINE 211 "src/System/Posix/Timer.hsc" #-}
            c_timer_create clock (castPtr $ (pEv :: Ptr Word8)) pTimer
        Nothing ->
          c_timer_create clock nullPtr pTimer
    peek pTimer

-- | Setup the timer. See /timer_settime(3)/.
configureTimer :: Timer
               -> Bool -- ^ Whether the expiration time is absolute.
               -> TimeSpec -- ^ Expiration time. Zero value disarms the timer.
               -> TimeSpec -- ^ Interval between subsequent expirations.
               -> IO (TimeSpec, TimeSpec)
configureTimer timer absolute value interval =
  with (ITimerSpec interval value) $ \pNew ->
    alloca $ \pOld -> do
      throwErrnoIfMinus1_ "configureTimer" $
        c_timer_settime timer
          (if absolute then 1 else 0) pNew pOld
{-# LINE 228 "src/System/Posix/Timer.hsc" #-}
      (ITimerSpec oldInterval oldValue) <- peek pOld
      return (oldValue, oldInterval)

-- | Get the amount of time left until the next expiration and the interval
--   between the subsequent expirations. See /timer_gettime(3)/.
timerTimeLeft :: Timer -> IO (TimeSpec, TimeSpec)
timerTimeLeft timer = do
  alloca $ \p -> do
    throwErrnoIfMinus1_ "timerTimeLeft" $ c_timer_gettime timer p
    (ITimerSpec interval value) <- peek p
    return (value, interval)

-- | Get the timer overrun count. See /timer_getoverrun(3)/.
timerOverrunCnt :: Timer -> IO CInt
timerOverrunCnt timer =
  throwErrnoIfMinus1 "timerOverrunCnt" $ c_timer_getoverrun timer

-- | Destroy the timer. See /timer_delete(3)/.
destroyTimer :: Timer -> IO ()
destroyTimer timer = throwErrnoIfMinus1_ "deleteTimer" $ c_timer_delete timer

foreign import ccall unsafe "clock_getcpuclockid"
  c_clock_getcpuclockid :: ProcessID -> Ptr Clock -> IO CInt
foreign import ccall unsafe "clock_getres"
  c_clock_getres :: Clock -> Ptr TimeSpec -> IO CInt
foreign import ccall unsafe "clock_gettime"
  c_clock_gettime :: Clock -> Ptr TimeSpec -> IO CInt
foreign import ccall unsafe "clock_settime"
  c_clock_settime :: Clock -> Ptr TimeSpec -> IO CInt
foreign import ccall unsafe "clock_nanosleep"
  c_clock_nanosleep :: Clock -> CInt -> Ptr TimeSpec -> Ptr TimeSpec -> IO CInt

foreign import ccall unsafe "timer_create"
  c_timer_create :: Clock -> Ptr () -> Ptr Timer -> IO CInt
foreign import ccall unsafe "timer_settime"
  c_timer_settime ::
    Timer -> CInt -> Ptr ITimerSpec -> Ptr ITimerSpec -> IO CInt
foreign import ccall unsafe "timer_gettime"
  c_timer_gettime :: Timer -> Ptr ITimerSpec -> IO CInt
foreign import ccall unsafe "timer_getoverrun"
  c_timer_getoverrun :: Timer -> IO CInt
foreign import ccall unsafe "timer_delete"
  c_timer_delete :: Timer -> IO CInt