{-# INCLUDE <sys/time.h> #-}
{-# LINE 1 "System/Posix/GetTimeOfDay.hsc" #-}
{-# OPTIONS -fffi -fglasgow-exts #-}
{-# LINE 2 "System/Posix/GetTimeOfDay.hsc" #-}
{- |
   Module      :  System.Posix.GetTimeOfDay
   Copyright   :  (c) 2006-04-08 by Peter Simons
   License     :  GPL2

   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  Haskell 2-pre

   A foreign function interface to @gettimeofday(2)@.
-}

module System.Posix.GetTimeOfDay where

import Foreign
import Foreign.C


{-# LINE 20 "System/Posix/GetTimeOfDay.hsc" #-}

-- |Marshaling for C's @struct timeval@.

data Timeval = Timeval CTime Int32
{-# LINE 24 "System/Posix/GetTimeOfDay.hsc" #-}

-- |Not really implemented by anyone; so we provide just a
-- place-holder. Pass 'nullPtr' to 'gettimeofday'.

data Timezone

instance Storable Timeval where
  sizeOf _    = (8)
{-# LINE 32 "System/Posix/GetTimeOfDay.hsc" #-}
  alignment _ = alignment (undefined :: CTime)
  poke ptr (Timeval t us)
              = do (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr t
{-# LINE 35 "System/Posix/GetTimeOfDay.hsc" #-}
                   (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr us
{-# LINE 36 "System/Posix/GetTimeOfDay.hsc" #-}
  peek ptr    = do t <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 37 "System/Posix/GetTimeOfDay.hsc" #-}
                   us <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 38 "System/Posix/GetTimeOfDay.hsc" #-}
                   return (Timeval t us)

-- |Write the current time as a 'Timeval'. The time is
-- returned in local time, no time zone correction takes
-- place. Signals errors with 'throwErrno'.

getTimeOfDay :: Ptr Timeval -> IO ()
getTimeOfDay p  = do
  rc <- gettimeofday p nullPtr
  case rc of
    0 -> return ()
    _ -> throwErrno "GetTimeOfDay"

-- |The @gettimeofday(2)@ system call.

foreign import ccall unsafe gettimeofday
  :: Ptr Timeval -> Ptr Timezone -> IO CInt