module GHC.Event.Clock (getCurrentTime) where
import Foreign (Ptr, Storable(..), nullPtr, with)
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.Types
import GHC.Base
import GHC.Err
import GHC.Num
import GHC.Real
getCurrentTime :: IO Double
getCurrentTime = do
tv <- with (CTimeval 0 0) $ \tvptr -> do
throwErrnoIfMinus1_ "gettimeofday" (gettimeofday tvptr nullPtr)
peek tvptr
let !t = realToFrac (sec tv) + realToFrac (usec tv) / 1000000.0
return t
data CTimeval = CTimeval
{ sec :: !CTime
, usec :: !CSUSeconds
}
instance Storable CTimeval where
sizeOf _ = (16)
alignment _ = alignment (undefined :: CLong)
peek ptr = do
sec' <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
usec' <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
return $ CTimeval sec' usec'
poke ptr tv = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (sec tv)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (usec tv)
foreign import capi unsafe "HsBase.h gettimeofday" gettimeofday
:: Ptr CTimeval -> Ptr () -> IO CInt