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

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

-- 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


-- Clock types
data Clock = Monotonic | Realtime | ProcessTime | ThreadTime

-- 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

-- TimeSpec structure
data TimeSpec = Time Int Int deriving (Show, Read)
sec  :: TimeSpec → Int
nsec :: TimeSpec → Int
sec  (Time s _) = s
nsec (Time _ n) = n

-- clock_gettime
clock_gettime :: Clock → IO TimeSpec
clock_gettime = call . time

-- clock_getres
clock_getres :: Clock → IO TimeSpec
clock_getres = call . res

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

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

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

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

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