{-# LINE 1 "src/Data/HodaTime/Instant/Unix.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Data.HodaTime.Instant.Unix
(
    now
)
where



import Data.HodaTime.Instant.Internal (fromUnixGetTimeOfDay, Instant)

import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.Types
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable

-- | Create an 'Instant' from the current system time
now :: IO Instant
now :: IO Instant
now = Int -> (Ptr () -> IO Instant) -> IO Instant
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
16) ((Ptr () -> IO Instant) -> IO Instant)
-> (Ptr () -> IO Instant) -> IO Instant
forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptv -> do
{-# LINE 21 "src/Data/HodaTime/Instant/Unix.hsc" #-}
  throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptv nullPtr
  CTime sec <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptv
{-# LINE 23 "src/Data/HodaTime/Instant/Unix.hsc" #-}
  CSUSeconds usec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptv
{-# LINE 24 "src/Data/HodaTime/Instant/Unix.hsc" #-}
  return $ fromUnixGetTimeOfDay (fromIntegral sec) (fromIntegral usec)
{-# INLINE now #-}

foreign import ccall unsafe "time.h gettimeofday"
  gettimeofday :: Ptr () -> Ptr () -> IO CInt