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

-- | POSIX timers.
module System.Posix.Timer (
    ITimerSpec(..),
    Timer,
    createTimer,
    configureTimer,
    timerTimeLeft,
    timerOverrunCnt,
    destroyTimer
  ) where

import Data.Word
import Control.Applicative ((<$>), (<*>))
import Control.Monad.Base
import Foreign.Storable (Storable(..))
import Foreign.Ptr (Ptr, WordPtr, nullPtr, castPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Utils (with)

{-# LINE 28 "src/System/Posix/Timer.hsc" #-}
import Foreign.C.Types (CInt)

{-# LINE 30 "src/System/Posix/Timer.hsc" #-}
import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)
import System.Posix.Signals (Signal)
import System.Posix.Clock (TimeSpec, Clock(..))


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

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

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


{-# LINE 39 "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 47 "src/System/Posix/Timer.hsc" #-}
  sizeOf _    = (16)
{-# LINE 48 "src/System/Posix/Timer.hsc" #-}
  peek p = ITimerSpec <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 49 "src/System/Posix/Timer.hsc" #-}
                      <*> (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 50 "src/System/Posix/Timer.hsc" #-}
  poke p (ITimerSpec interval value) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p interval
{-# LINE 52 "src/System/Posix/Timer.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) p value
{-# LINE 53 "src/System/Posix/Timer.hsc" #-}

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

-- | Create a timer. See /timer_create(3)/.
createTimer ∷ MonadBase μ IO
            ⇒ Clock
            → Maybe (Signal, WordPtr) -- ^ Optional signal to raise on timer
                                      --   expirations and value of
                                      --   /siginfo.si_value/.
            → μ Timer
createTimer clock sigEvent =
  liftBase $ alloca $ \pTimer → do
    throwErrnoIfMinus1_ "createTimer" $
      case sigEvent of
        Just (signal, ud) → do
          allocaBytes (64) $ \pEv → do
{-# LINE 70 "src/System/Posix/Timer.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 8) pEv
{-# LINE 71 "src/System/Posix/Timer.hsc" #-}
              (0 ∷ CInt)
{-# LINE 72 "src/System/Posix/Timer.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 4) pEv signal
{-# LINE 73 "src/System/Posix/Timer.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 0) pEv ud
{-# LINE 74 "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 ∷ MonadBase μ IO
               ⇒ Timer
               → Bool -- ^ Whether the expiration time is absolute.
               → TimeSpec -- ^ Expiration time. Zero value disarms the timer.
               → TimeSpec -- ^ Interval between subsequent expirations.
               → μ (TimeSpec, TimeSpec)
configureTimer timer absolute value interval =
  liftBase $ with (ITimerSpec interval value) $ \pNew →
    alloca $ \pOld → do
      throwErrnoIfMinus1_ "configureTimer" $
        c_timer_settime timer
          (if absolute then 1 else 0) pNew pOld
{-# LINE 92 "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 ∷ MonadBase μ IO ⇒ Timer → μ (TimeSpec, TimeSpec)
timerTimeLeft timer =
  liftBase $ 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 ∷ MonadBase μ IO ⇒ Timer → μ CInt
timerOverrunCnt timer =
  liftBase $ throwErrnoIfMinus1 "timerOverrunCnt" $ c_timer_getoverrun timer

-- | Destroy the timer. See /timer_delete(3)/.
destroyTimer ∷ MonadBase μ IO ⇒ Timer → μ ()
destroyTimer timer =
  liftBase $ throwErrnoIfMinus1_ "deleteTimer" $ c_timer_delete timer

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