Clock.hs

-- | From time.h, provides clockid_t, timespec, clock_gettime, clock_getres.
module System.CPUTime.Clock (

  Clock (Monotonic, Realtime, ProcessTime, ThreadTime),
  TimeSpec (Time),

  clock_gettime,
  clock_getres,

  sec,
  nsec,  

) where

import GHC.Ptr
--import System.IO.Unsafe
import Foreign.Storable
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Array

-- | Clock types
data Clock = Monotonic   -- ^ Clock that cannot be set and represents monotonic time since some unspecified starting point. 
           | Realtime    -- ^ System-wide realtime clock
           | ProcessTime -- ^ High-resolution per-process timer from the CPU. 
           | ThreadTime  -- ^ Thread-specific CPU-time clock. 

-- | TimeSpec structure
data TimeSpec = Time Int Int deriving (Show, Read)

-- | Seconds of a TimeSpec
sec  :: TimeSpec → Int
sec  (Time s _) = s

-- | Nanoseconds of a TimeSpec
nsec :: TimeSpec → Int
nsec (Time _ n) = n

-- | Retrieves the time of the specified clock.
clock_gettime :: Clock → IO TimeSpec
clock_gettime = call . time

-- | Finds the resolution (precision) of the specified clock.
clock_getres :: Clock → IO TimeSpec
clock_getres = call . res

---------------------------------------------

-- Reader function
type ReaderFunc = Ptr Int → IO ()

-- Clock-to-time reading
time :: Clock → ReaderFunc
time Monotonic = clock_readtime_monotonic
time Realtime  = clock_readtime_realtime
time ProcessTime = clock_readtime_processtime
time ThreadTime = clock_readtime_threadtime

-- Clock-to-res reading
res :: Clock → ReaderFunc
res Monotonic = clock_readres_monotonic
res Realtime  = clock_readres_realtime
res ProcessTime = clock_readres_processtime
res ThreadTime = clock_readres_threadtime

-- Readers
foreign import ccall clock_readtime_monotonic :: ReaderFunc
foreign import ccall clock_readtime_realtime :: ReaderFunc
foreign import ccall clock_readtime_processtime :: ReaderFunc
foreign import ccall clock_readtime_threadtime :: ReaderFunc

foreign import ccall clock_readres_monotonic :: ReaderFunc
foreign import ccall clock_readres_realtime :: ReaderFunc
foreign import ccall clock_readres_processtime :: ReaderFunc
foreign import ccall clock_readres_threadtime :: ReaderFunc

-- Marshalling
call :: ReaderFunc → IO TimeSpec
call read_ = do
  t ← (2 ↑≣)
  read_ t
  s ← (t ≣→ 0)
  n ← (t ≣→ 1)
  (t ≣⊠)
  return $ Time s n

-- Arrays

(↑≣) :: Storable a ⇒ Int → IO (Ptr a)
(↑≣) = mallocArray

(≣→) :: Storable a ⇒ Ptr a → Int → IO a
(≣→) = peekElemOff

(≣⊠) :: Ptr a → IO ()
(≣⊠) = Foreign.Marshal.Alloc.free