{-# LINE 1 "src/System/Posix/Timer.hsc" #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# 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 26 "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(..))








-- | Mirrors /struct itimerspec/.
data ITimerSpec = ITimerSpec { ITimerSpec -> TimeSpec
iTimerSpecInterval ∷ !TimeSpec
                             , ITimerSpec -> TimeSpec
iTimerSpecValue    ∷ !TimeSpec
                             } deriving (ITimerSpec -> ITimerSpec -> Bool
(ITimerSpec -> ITimerSpec -> Bool)
-> (ITimerSpec -> ITimerSpec -> Bool) -> Eq ITimerSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ITimerSpec -> ITimerSpec -> Bool
== :: ITimerSpec -> ITimerSpec -> Bool
$c/= :: ITimerSpec -> ITimerSpec -> Bool
/= :: ITimerSpec -> ITimerSpec -> Bool
Eq, Int -> ITimerSpec -> ShowS
[ITimerSpec] -> ShowS
ITimerSpec -> String
(Int -> ITimerSpec -> ShowS)
-> (ITimerSpec -> String)
-> ([ITimerSpec] -> ShowS)
-> Show ITimerSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ITimerSpec -> ShowS
showsPrec :: Int -> ITimerSpec -> ShowS
$cshow :: ITimerSpec -> String
show :: ITimerSpec -> String
$cshowList :: [ITimerSpec] -> ShowS
showList :: [ITimerSpec] -> ShowS
Show)

instance Storable ITimerSpec where
  alignment :: ITimerSpec -> Int
alignment ITimerSpec
_ = Int
8
{-# LINE 48 "src/System/Posix/Timer.hsc" #-}
  sizeOf _    = (32)
{-# LINE 49 "src/System/Posix/Timer.hsc" #-}
  peek p = ITimerSpec <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 50 "src/System/Posix/Timer.hsc" #-}
                      <*> (\hsc_ptr -> peekByteOff hsc_ptr 16) p
{-# LINE 51 "src/System/Posix/Timer.hsc" #-}
  poke p (ITimerSpec interval value) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p interval
{-# LINE 53 "src/System/Posix/Timer.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) p value
{-# LINE 54 "src/System/Posix/Timer.hsc" #-}

-- | Mirrors /timer_t/.
newtype Timer = Timer Word64 deriving (Timer -> Timer -> Bool
(Timer -> Timer -> Bool) -> (Timer -> Timer -> Bool) -> Eq Timer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timer -> Timer -> Bool
== :: Timer -> Timer -> Bool
$c/= :: Timer -> Timer -> Bool
/= :: Timer -> Timer -> Bool
Eq, Eq Timer
Eq Timer =>
(Timer -> Timer -> Ordering)
-> (Timer -> Timer -> Bool)
-> (Timer -> Timer -> Bool)
-> (Timer -> Timer -> Bool)
-> (Timer -> Timer -> Bool)
-> (Timer -> Timer -> Timer)
-> (Timer -> Timer -> Timer)
-> Ord Timer
Timer -> Timer -> Bool
Timer -> Timer -> Ordering
Timer -> Timer -> Timer
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
$ccompare :: Timer -> Timer -> Ordering
compare :: Timer -> Timer -> Ordering
$c< :: Timer -> Timer -> Bool
< :: Timer -> Timer -> Bool
$c<= :: Timer -> Timer -> Bool
<= :: Timer -> Timer -> Bool
$c> :: Timer -> Timer -> Bool
> :: Timer -> Timer -> Bool
$c>= :: Timer -> Timer -> Bool
>= :: Timer -> Timer -> Bool
$cmax :: Timer -> Timer -> Timer
max :: Timer -> Timer -> Timer
$cmin :: Timer -> Timer -> Timer
min :: Timer -> Timer -> Timer
Ord, Int -> Timer -> ShowS
[Timer] -> ShowS
Timer -> String
(Int -> Timer -> ShowS)
-> (Timer -> String) -> ([Timer] -> ShowS) -> Show Timer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timer -> ShowS
showsPrec :: Int -> Timer -> ShowS
$cshow :: Timer -> String
show :: Timer -> String
$cshowList :: [Timer] -> ShowS
showList :: [Timer] -> ShowS
Show, Ptr Timer -> IO Timer
Ptr Timer -> Int -> IO Timer
Ptr Timer -> Int -> Timer -> IO ()
Ptr Timer -> Timer -> IO ()
Timer -> Int
(Timer -> Int)
-> (Timer -> Int)
-> (Ptr Timer -> Int -> IO Timer)
-> (Ptr Timer -> Int -> Timer -> IO ())
-> (forall b. Ptr b -> Int -> IO Timer)
-> (forall b. Ptr b -> Int -> Timer -> IO ())
-> (Ptr Timer -> IO Timer)
-> (Ptr Timer -> Timer -> IO ())
-> Storable Timer
forall b. Ptr b -> Int -> IO Timer
forall b. Ptr b -> Int -> Timer -> 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
$csizeOf :: Timer -> Int
sizeOf :: Timer -> Int
$calignment :: Timer -> Int
alignment :: Timer -> Int
$cpeekElemOff :: Ptr Timer -> Int -> IO Timer
peekElemOff :: Ptr Timer -> Int -> IO Timer
$cpokeElemOff :: Ptr Timer -> Int -> Timer -> IO ()
pokeElemOff :: Ptr Timer -> Int -> Timer -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Timer
peekByteOff :: forall b. Ptr b -> Int -> IO Timer
$cpokeByteOff :: forall b. Ptr b -> Int -> Timer -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Timer -> IO ()
$cpeek :: Ptr Timer -> IO Timer
peek :: Ptr Timer -> IO Timer
$cpoke :: Ptr Timer -> Timer -> IO ()
poke :: Ptr Timer -> Timer -> IO ()
Storable)
{-# LINE 57 "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 :: forall (μ :: * -> *).
MonadBase IO μ =>
Clock -> Maybe (Signal, WordPtr) -> μ Timer
createTimer Clock
clock Maybe (Signal, WordPtr)
sigEvent =
  IO Timer -> μ Timer
forall α. IO α -> μ α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Timer -> μ Timer) -> IO Timer -> μ Timer
forall a b. (a -> b) -> a -> b
$ (Ptr Timer -> IO Timer) -> IO Timer
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Timer -> IO Timer) -> IO Timer)
-> (Ptr Timer -> IO Timer) -> IO Timer
forall a b. (a -> b) -> a -> b
$ \Ptr Timer
pTimer → do
    String -> IO Signal -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"createTimer" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
      case Maybe (Signal, WordPtr)
sigEvent of
        Just (Signal
signal, WordPtr
ud) → do
          Int -> (Ptr Word8 -> IO Signal) -> IO Signal
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
64) ((Ptr Word8 -> IO Signal) -> IO Signal)
-> (Ptr Word8 -> IO Signal) -> IO Signal
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pEv → do
{-# LINE 71 "src/System/Posix/Timer.hsc" #-}
            (\Ptr Word8
hsc_ptr -> Ptr Word8 -> Int -> Signal -> IO ()
forall b. Ptr b -> Int -> Signal -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
hsc_ptr Int
12) Ptr Word8
pEv
{-# LINE 72 "src/System/Posix/Timer.hsc" #-}
              (Signal
0 ∷ CInt)
{-# LINE 73 "src/System/Posix/Timer.hsc" #-}
            (\Ptr Word8
hsc_ptr -> Ptr Word8 -> Int -> Signal -> IO ()
forall b. Ptr b -> Int -> Signal -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
hsc_ptr Int
8) Ptr Word8
pEv Signal
signal
{-# LINE 74 "src/System/Posix/Timer.hsc" #-}
            (\Ptr Word8
hsc_ptr -> Ptr Word8 -> Int -> WordPtr -> IO ()
forall b. Ptr b -> Int -> WordPtr -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
hsc_ptr Int
0) Ptr Word8
pEv WordPtr
ud
{-# LINE 75 "src/System/Posix/Timer.hsc" #-}
            Clock -> Ptr () -> Ptr Timer -> IO Signal
c_timer_create Clock
clock (Ptr Word8 -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr ()) -> Ptr Word8 -> Ptr ()
forall a b. (a -> b) -> a -> b
$ (Ptr Word8
pEv ∷ Ptr Word8)) Ptr Timer
pTimer
        Maybe (Signal, WordPtr)
Nothing →
          Clock -> Ptr () -> Ptr Timer -> IO Signal
c_timer_create Clock
clock Ptr ()
forall a. Ptr a
nullPtr Ptr Timer
pTimer
    Ptr Timer -> IO Timer
forall a. Storable a => Ptr a -> IO a
peek Ptr Timer
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 :: forall (μ :: * -> *).
MonadBase IO μ =>
Timer -> Bool -> TimeSpec -> TimeSpec -> μ (TimeSpec, TimeSpec)
configureTimer Timer
timer Bool
absolute TimeSpec
value TimeSpec
interval =
  IO (TimeSpec, TimeSpec) -> μ (TimeSpec, TimeSpec)
forall α. IO α -> μ α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (TimeSpec, TimeSpec) -> μ (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec) -> μ (TimeSpec, TimeSpec)
forall a b. (a -> b) -> a -> b
$ ITimerSpec
-> (Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (TimeSpec -> TimeSpec -> ITimerSpec
ITimerSpec TimeSpec
interval TimeSpec
value) ((Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
 -> IO (TimeSpec, TimeSpec))
-> (Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr ITimerSpec
pNew →
    (Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
 -> IO (TimeSpec, TimeSpec))
-> (Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr ITimerSpec
pOld → do
      String -> IO Signal -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"configureTimer" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
        Timer -> Signal -> Ptr ITimerSpec -> Ptr ITimerSpec -> IO Signal
c_timer_settime Timer
timer
          (if Bool
absolute then Signal
1 else Signal
0) Ptr ITimerSpec
pNew Ptr ITimerSpec
pOld
{-# LINE 93 "src/System/Posix/Timer.hsc" #-}
      ITimerSpec oldInterval oldValue ← peek pOld
      (TimeSpec, TimeSpec) -> IO (TimeSpec, TimeSpec)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSpec
oldValue, TimeSpec
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 :: forall (μ :: * -> *).
MonadBase IO μ =>
Timer -> μ (TimeSpec, TimeSpec)
timerTimeLeft Timer
timer =
  IO (TimeSpec, TimeSpec) -> μ (TimeSpec, TimeSpec)
forall α. IO α -> μ α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (TimeSpec, TimeSpec) -> μ (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec) -> μ (TimeSpec, TimeSpec)
forall a b. (a -> b) -> a -> b
$ (Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
 -> IO (TimeSpec, TimeSpec))
-> (Ptr ITimerSpec -> IO (TimeSpec, TimeSpec))
-> IO (TimeSpec, TimeSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr ITimerSpec
p → do
    String -> IO Signal -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"timerTimeLeft" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Timer -> Ptr ITimerSpec -> IO Signal
c_timer_gettime Timer
timer Ptr ITimerSpec
p
    ITimerSpec TimeSpec
interval TimeSpec
value ← Ptr ITimerSpec -> IO ITimerSpec
forall a. Storable a => Ptr a -> IO a
peek Ptr ITimerSpec
p
    (TimeSpec, TimeSpec) -> IO (TimeSpec, TimeSpec)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSpec
value, TimeSpec
interval)

-- | Get the timer overrun count. See /timer_getoverrun(3)/.
timerOverrunCnt ∷ MonadBase IO μ ⇒ Timer → μ CInt
timerOverrunCnt :: forall (μ :: * -> *). MonadBase IO μ => Timer -> μ Signal
timerOverrunCnt Timer
timer =
  IO Signal -> μ Signal
forall α. IO α -> μ α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Signal -> μ Signal) -> IO Signal -> μ Signal
forall a b. (a -> b) -> a -> b
$ String -> IO Signal -> IO Signal
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"timerOverrunCnt" (IO Signal -> IO Signal) -> IO Signal -> IO Signal
forall a b. (a -> b) -> a -> b
$ Timer -> IO Signal
c_timer_getoverrun Timer
timer

-- | Destroy the timer. See /timer_delete(3)/.
destroyTimer ∷ MonadBase IO μ ⇒ Timer → μ ()
destroyTimer :: forall (μ :: * -> *). MonadBase IO μ => Timer -> μ ()
destroyTimer Timer
timer =
  IO () -> μ ()
forall α. IO α -> μ α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> μ ()) -> IO () -> μ ()
forall a b. (a -> b) -> a -> b
$ String -> IO Signal -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"deleteTimer" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Timer -> IO Signal
c_timer_delete Timer
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