module Data.Time.Exts.C where
import Data.Convertible (Convertible(..))
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..), CLong, CTime(..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Unsafe (unsafeLocalState)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (FunPtr, Ptr, nullPtr, plusPtr)
import Foreign.Storable (Storable(..))
data C'tm = C'tm{
c'tm'tm_sec :: CInt,
c'tm'tm_min :: CInt,
c'tm'tm_hour :: CInt,
c'tm'tm_mday :: CInt,
c'tm'tm_mon :: CInt,
c'tm'tm_year :: CInt,
c'tm'tm_wday :: CInt,
c'tm'tm_yday :: CInt,
c'tm'tm_isdst :: CInt,
c'tm'tm_gmtoff :: CLong,
c'tm'tm_zone :: CString
} deriving (Eq,Show)
p'tm'tm_sec p = plusPtr p 0
p'tm'tm_sec :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_min p = plusPtr p 4
p'tm'tm_min :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_hour p = plusPtr p 8
p'tm'tm_hour :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_mday p = plusPtr p 12
p'tm'tm_mday :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_mon p = plusPtr p 16
p'tm'tm_mon :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_year p = plusPtr p 20
p'tm'tm_year :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_wday p = plusPtr p 24
p'tm'tm_wday :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_yday p = plusPtr p 28
p'tm'tm_yday :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_isdst p = plusPtr p 32
p'tm'tm_isdst :: Ptr (C'tm) -> Ptr (CInt)
p'tm'tm_gmtoff p = plusPtr p 40
p'tm'tm_gmtoff :: Ptr (C'tm) -> Ptr (CLong)
p'tm'tm_zone p = plusPtr p 48
p'tm'tm_zone :: Ptr (C'tm) -> Ptr (CString)
instance Storable C'tm where
sizeOf _ = 56
alignment _ = 8
peek p = do
v0 <- peekByteOff p 0
v1 <- peekByteOff p 4
v2 <- peekByteOff p 8
v3 <- peekByteOff p 12
v4 <- peekByteOff p 16
v5 <- peekByteOff p 20
v6 <- peekByteOff p 24
v7 <- peekByteOff p 28
v8 <- peekByteOff p 32
v9 <- peekByteOff p 40
v10 <- peekByteOff p 48
return $ C'tm v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10
poke p (C'tm v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10) = do
pokeByteOff p 0 v0
pokeByteOff p 4 v1
pokeByteOff p 8 v2
pokeByteOff p 12 v3
pokeByteOff p 16 v4
pokeByteOff p 20 v5
pokeByteOff p 24 v6
pokeByteOff p 28 v7
pokeByteOff p 32 v8
pokeByteOff p 40 v9
pokeByteOff p 48 v10
return ()
data C'timeval = C'timeval{
c'timeval'tv_sec :: CLong,
c'timeval'tv_usec :: CLong
} deriving (Eq,Show)
p'timeval'tv_sec p = plusPtr p 0
p'timeval'tv_sec :: Ptr (C'timeval) -> Ptr (CLong)
p'timeval'tv_usec p = plusPtr p 8
p'timeval'tv_usec :: Ptr (C'timeval) -> Ptr (CLong)
instance Storable C'timeval where
sizeOf _ = 16
alignment _ = 8
peek p = do
v0 <- peekByteOff p 0
v1 <- peekByteOff p 8
return $ C'timeval v0 v1
poke p (C'timeval v0 v1) = do
pokeByteOff p 0 v0
pokeByteOff p 8 v1
return ()
foreign import ccall "timegm" c'timegm
:: Ptr C'tm -> IO CTime
foreign import ccall "&timegm" p'timegm
:: FunPtr (Ptr C'tm -> IO CTime)
foreign import ccall "gmtime_r" c'gmtime_r
:: Ptr CTime -> Ptr C'tm -> IO (Ptr C'tm)
foreign import ccall "&gmtime_r" p'gmtime_r
:: FunPtr (Ptr CTime -> Ptr C'tm -> IO (Ptr C'tm))
foreign import ccall "gettimeofday" c'gettimeofday
:: Ptr C'timeval -> Ptr () -> IO CInt
foreign import ccall "&gettimeofday" p'gettimeofday
:: FunPtr (Ptr C'timeval -> Ptr () -> IO CInt)
instance Convertible CTime C'tm where
safeConvert = Right . unsafeLocalState . flip with f
where f x = alloca $ \ ptr -> c'gmtime_r x ptr >>= peek
instance Convertible C'tm CTime where
safeConvert = Right . unsafeLocalState . flip with c'timegm
getTimeOfDay :: IO C'timeval
getTimeOfDay = with (C'timeval 0 0) $ \ ptr -> c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr
getResult _ err = error $ "getTimeOfDay: " ++ show err