-- | -- Module : Data.Hourglass.Internal.Unix -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Time lowlevel helpers for the unix operating system -- -- depend on localtime_r and gmtime_r. -- Some obscure unix system might not support them. -- {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} module Data.Hourglass.Internal.Unix ( dateTimeFromUnixEpochP , dateTimeFromUnixEpoch , systemGetTimezone , systemGetElapsed , systemGetElapsedP ) where import Control.Applicative import Foreign.C.Types import Foreign.Storable import Foreign.Marshal.Alloc import Foreign.Ptr import Data.Hourglass.Types import System.IO.Unsafe -- | convert a unix epoch precise to DateTime dateTimeFromUnixEpochP :: ElapsedP -> DateTime dateTimeFromUnixEpochP (ElapsedP e ns) = fromCP ns $ rawGmTime e -- | convert a unix epoch to DateTime dateTimeFromUnixEpoch :: Elapsed -> DateTime dateTimeFromUnixEpoch e = fromC $ rawGmTime e -- | return the timezone offset in minutes systemGetTimezone :: IO TimezoneOffset systemGetTimezone = TimezoneOffset . fromIntegral . flip div 60 <$> localTime 0 ---------------------------------------------------------------------------------------- -- | return the current elapsedP systemGetElapsedP :: IO ElapsedP systemGetElapsedP = allocaBytesAligned sofTimespec 8 $ \ptr -> do c_clock_get ptr toElapsedP <$> peek (castPtr ptr) <*> peekByteOff (castPtr ptr) sofCTime where sofTimespec = sofCTime + sofCLong sofCTime = sizeOf (0 :: CTime) sofCLong = sizeOf (0 :: CLong) #if (MIN_VERSION_base(4,5,0)) toElapsedP :: CTime -> CLong -> ElapsedP toElapsedP (CTime sec) nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec) #else toElapsedP :: CLong -> CLong -> ElapsedP toElapsedP sec nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec) #endif -- | return the current elapsed systemGetElapsed :: IO Elapsed systemGetElapsed = allocaBytesAligned sofTimespec 8 $ \ptr -> do c_clock_get ptr toElapsed <$> peek (castPtr ptr) where sofTimespec = sizeOf (0 :: CTime) + sizeOf (0 :: CLong) #if (MIN_VERSION_base(4,5,0)) toElapsed :: CTime -> Elapsed toElapsed (CTime sec) = Elapsed $ Seconds (fromIntegral sec) #else toElapsed :: CLong -> Elapsed toElapsed sec = Elapsed $ Seconds (fromIntegral sec) #endif foreign import ccall unsafe "hourglass_clock_calendar" c_clock_get :: Ptr CLong -> IO () #if (MIN_VERSION_base(4,5,0)) foreign import ccall unsafe "gmtime_r" c_gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) foreign import ccall unsafe "localtime_r" c_localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe "gmtime_r" c_gmtime_r :: Ptr CLong -> Ptr CTm -> IO (Ptr CTm) foreign import ccall unsafe "localtime_r" c_localtime_r :: Ptr CLong -> Ptr CTm -> IO (Ptr CTm) #endif -- | Return a global time's struct tm based on the number of elapsed second since unix epoch. rawGmTime :: Elapsed -> CTm rawGmTime (Elapsed (Seconds s)) = unsafePerformIO callTime where callTime = alloca $ \ctmPtr -> do alloca $ \ctimePtr -> do poke ctimePtr ctime r <- c_gmtime_r ctimePtr ctmPtr if r == nullPtr then error "gmTime failed" else peek ctmPtr ctime = fromIntegral s {-# NOINLINE rawGmTime #-} -- | Return a local time's gmtoff (seconds east of UTC) -- -- use the ill defined gmtoff (at offset 40) that might or might not be -- available for your platform. worst case scenario it's not initialized -- properly. localTime :: Elapsed -> IO CLong localTime (Elapsed (Seconds s)) = callTime where callTime = alloca $ \ctmPtr -> do alloca $ \ctimePtr -> do poke ctimePtr ctime r <- c_localtime_r ctimePtr ctmPtr if r == nullPtr then error "localTime failed" else peekByteOff ctmPtr 40 ctime = fromIntegral s -- | Represent the beginning of struct tm data CTm = CTm { ctmSec :: CInt , ctmMin :: CInt , ctmHour :: CInt , ctmMDay :: CInt , ctmMon :: CInt , ctmYear :: CInt } deriving (Show,Eq) -- | Convert a C structure to a DateTime structure fromC :: CTm -> DateTime fromC ctm = DateTime date time where date = Date { dateYear = fromIntegral $ ctmYear ctm + 1900 , dateMonth = toEnum $ fromIntegral $ ctmMon ctm , dateDay = fromIntegral $ ctmMDay ctm } time = TimeOfDay { todHour = fromIntegral $ ctmHour ctm , todMin = fromIntegral $ ctmMin ctm , todSec = fromIntegral $ ctmSec ctm , todNSec = 0 } -- | Similar to 'fromC' except with nanosecond precision fromCP :: NanoSeconds -> CTm -> DateTime fromCP ns ctm = DateTime d (t { todNSec = ns }) where (DateTime d t) = fromC ctm instance Storable CTm where alignment _ = 8 sizeOf _ = 60 -- account for 9 ints, alignment + 2 unsigned long at end. peek ptr = do CTm <$> peekByteOff intPtr 0 <*> peekByteOff intPtr 4 <*> peekByteOff intPtr 8 <*> peekByteOff intPtr 12 <*> peekByteOff intPtr 16 <*> peekByteOff intPtr 20 where intPtr = castPtr ptr poke ptr (CTm f0 f1 f2 f3 f4 f5) = do mapM_ (uncurry (pokeByteOff intPtr)) [(0,f0), (4,f1), (8,f2), (12,f3), (16,f4), (20,f5)] --pokeByteOff (castPtr ptr) 36 f9 where intPtr = castPtr ptr