diff --git a/posix-timer.cabal b/posix-timer.cabal --- a/posix-timer.cabal +++ b/posix-timer.cabal @@ -1,11 +1,14 @@ Name: posix-timer -Version: 0.1 +Version: 0.2 Category: System Stability: experimental Synopsis: Bindings to POSIX clock and timer functions. Description: This package provides bindings to POSIX clock and timer functions. +Homepage: https://github.com/mvv/posix-timer +Bug-Reports: https://github.com/mvv/posix-timer/issues + Author: Mikhail Vorozhtsov Maintainer: Mikhail Vorozhtsov Copyright: 2010 Mikhail Vorozhtsov @@ -22,7 +25,7 @@ Location: https://github.com/mvv/posix-timer.git Library - Build-Depends: base < 5, unix + Build-Depends: base < 5, unix, transformers-base Hs-Source-Dirs: src Include-Dirs: include GHC-Options: -Wall diff --git a/src/System/Posix/Clock.hsc b/src/System/Posix/Clock.hsc --- a/src/System/Posix/Clock.hsc +++ b/src/System/Posix/Clock.hsc @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} -- | POSIX clocks. module System.Posix.Clock ( @@ -31,6 +32,7 @@ import Data.Ratio (numerator) import Data.List (unfoldr) import Control.Applicative ((<$>), (<*>)) +import Control.Monad.Base import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (Storable(..)) import Foreign.Marshal.Alloc (alloca) @@ -187,36 +189,37 @@ -- | Get the CPU-time clock of the given process. -- See /clock_getcpuclockid(3)/. -getProcessClock ∷ ProcessID → IO Clock +getProcessClock ∷ MonadBase μ IO ⇒ ProcessID → μ Clock getProcessClock pid = - alloca $ \p → do + liftBase $ 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 ∷ MonadBase μ IO ⇒ Clock → μ TimeSpec getClockResolution clock = - alloca $ \p → do + liftBase $ 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 ∷ MonadBase μ IO ⇒ Clock → μ TimeSpec getClockTime clock = - alloca $ \p → do + liftBase $ 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 ∷ MonadBase μ IO ⇒ Clock → TimeSpec → μ () setClockTime clock ts = - with ts $ throwErrnoIfMinus1_ "setClockTime" . c_clock_settime clock + liftBase $ 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 ∷ MonadBase μ IO ⇒ Clock → TimeSpec → μ TimeSpec clockSleep clock ts = - with ts $ \pTs → + liftBase $ with ts $ \pTs → alloca $ \pLeft → do result ← c_clock_nanosleep clock 0 pTs pLeft if result == 0 @@ -229,9 +232,9 @@ -- | Sleep until the clock time reaches the specified value. -- See /clock_nanosleep(3)/. -clockSleepAbs ∷ Clock → TimeSpec → IO () +clockSleepAbs ∷ MonadBase μ IO ⇒ Clock → TimeSpec → μ () clockSleepAbs clock ts = - with ts $ \p → + liftBase $ with ts $ \p → throwErrnoIfMinus1_ "clockSleepAbs" $ c_clock_nanosleep clock #{const TIMER_ABSTIME} p nullPtr @@ -243,6 +246,6 @@ 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" +foreign import ccall "clock_nanosleep" c_clock_nanosleep ∷ Clock → CInt → Ptr TimeSpec → Ptr TimeSpec → IO CInt diff --git a/src/System/Posix/Timer.hsc b/src/System/Posix/Timer.hsc --- a/src/System/Posix/Timer.hsc +++ b/src/System/Posix/Timer.hsc @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} -- | POSIX timers. module System.Posix.Timer ( @@ -16,6 +17,7 @@ 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) @@ -49,13 +51,14 @@ newtype Timer = Timer #{itype timer_t} deriving (Eq, Ord, Show, Storable) -- | Create a timer. See /timer_create(3)/. -createTimer ∷ Clock +createTimer ∷ MonadBase μ IO + ⇒ 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 + -- expirations and value of + -- /siginfo.si_value/. + → μ Timer +createTimer clock sigEvent = + liftBase $ alloca $ \pTimer → do throwErrnoIfMinus1_ "createTimer" $ case sigEvent of Just (signal, ud) → do @@ -70,13 +73,14 @@ peek pTimer -- | Setup the timer. See /timer_settime(3)/. -configureTimer ∷ Timer +configureTimer ∷ MonadBase μ IO + ⇒ Timer → Bool -- ^ Whether the expiration time is absolute. → TimeSpec -- ^ Expiration time. Zero value disarms the timer. → TimeSpec -- ^ Interval between subsequent expirations. - → IO (TimeSpec, TimeSpec) + → μ (TimeSpec, TimeSpec) configureTimer timer absolute value interval = - with (ITimerSpec interval value) $ \pNew → + liftBase $ with (ITimerSpec interval value) $ \pNew → alloca $ \pOld → do throwErrnoIfMinus1_ "configureTimer" $ c_timer_settime timer @@ -86,21 +90,22 @@ -- | 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 ∷ MonadBase μ IO ⇒ Timer → μ (TimeSpec, TimeSpec) timerTimeLeft timer = - alloca $ \p → do + 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 ∷ Timer → IO CInt +timerOverrunCnt ∷ MonadBase μ IO ⇒ Timer → μ CInt timerOverrunCnt timer = - throwErrnoIfMinus1 "timerOverrunCnt" $ c_timer_getoverrun timer + liftBase $ throwErrnoIfMinus1 "timerOverrunCnt" $ c_timer_getoverrun timer -- | Destroy the timer. See /timer_delete(3)/. -destroyTimer ∷ Timer → IO () -destroyTimer timer = throwErrnoIfMinus1_ "deleteTimer" $ c_timer_delete timer +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