{-# LINE 1 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 2 "System/Directory/Internal/C_utimensat.hsc" #-}


{-# LINE 4 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 5 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 6 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 7 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 8 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 9 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 10 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 11 "System/Directory/Internal/C_utimensat.hsc" #-}

{-# LINE 12 "System/Directory/Internal/C_utimensat.hsc" #-}

module System.Directory.Internal.C_utimensat where

{-# LINE 15 "System/Directory/Internal/C_utimensat.hsc" #-}
import Foreign
import Foreign.C
import Data.Time.Clock.POSIX (POSIXTime)
import System.Posix.Types

data CTimeSpec = CTimeSpec EpochTime CLong

instance Storable CTimeSpec where
    sizeOf    _ = (16)
{-# LINE 24 "System/Directory/Internal/C_utimensat.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    poke p (CTimeSpec sec nsec) = do
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p sec
{-# LINE 27 "System/Directory/Internal/C_utimensat.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p nsec
{-# LINE 28 "System/Directory/Internal/C_utimensat.hsc" #-}
    peek p = do
      sec  <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 30 "System/Directory/Internal/C_utimensat.hsc" #-}
      nsec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 31 "System/Directory/Internal/C_utimensat.hsc" #-}
      return (CTimeSpec sec nsec)

c_AT_FDCWD :: CInt
c_AT_FDCWD = (-100)
{-# LINE 35 "System/Directory/Internal/C_utimensat.hsc" #-}

utimeOmit :: CTimeSpec
utimeOmit = CTimeSpec (CTime 0) (1073741822)
{-# LINE 38 "System/Directory/Internal/C_utimensat.hsc" #-}

toCTimeSpec :: POSIXTime -> CTimeSpec
toCTimeSpec t = CTimeSpec (CTime sec) (truncate $ 10 ^ (9 :: Int) * frac)
  where
    (sec,  frac)  = if frac' < 0 then (sec' - 1, frac' + 1) else (sec', frac')
    (sec', frac') = properFraction (toRational t)

foreign import ccall "utimensat" c_utimensat
  :: CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt


{-# LINE 49 "System/Directory/Internal/C_utimensat.hsc" #-}