{-# 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
dateTimeFromUnixEpochP :: ElapsedP -> DateTime
dateTimeFromUnixEpochP :: ElapsedP -> DateTime
dateTimeFromUnixEpochP (ElapsedP Elapsed
e NanoSeconds
ns) = NanoSeconds -> CTm -> DateTime
fromCP NanoSeconds
ns forall a b. (a -> b) -> a -> b
$ Elapsed -> CTm
rawGmTime Elapsed
e
dateTimeFromUnixEpoch :: Elapsed -> DateTime
dateTimeFromUnixEpoch :: Elapsed -> DateTime
dateTimeFromUnixEpoch Elapsed
e = CTm -> DateTime
fromC forall a b. (a -> b) -> a -> b
$ Elapsed -> CTm
rawGmTime Elapsed
e
systemGetTimezone :: IO TimezoneOffset
systemGetTimezone :: IO TimezoneOffset
systemGetTimezone = Int -> TimezoneOffset
TimezoneOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> a
div CLong
60 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elapsed -> IO CLong
localTime Elapsed
0
systemGetElapsedP :: IO ElapsedP
systemGetElapsedP :: IO ElapsedP
systemGetElapsedP = forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned Int
sofTimespec Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr CLong
ptr -> do
Ptr CLong -> IO ()
c_clock_get Ptr CLong
ptr
CTime -> CLong -> ElapsedP
toElapsedP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr CLong
ptr) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (forall a b. Ptr a -> Ptr b
castPtr Ptr CLong
ptr) Int
sofCTime
where sofTimespec :: Int
sofTimespec = Int
sofCTime forall a. Num a => a -> a -> a
+ Int
sofCLong
sofCTime :: Int
sofCTime = forall a. Storable a => a -> Int
sizeOf (CTime
0 :: CTime)
sofCLong :: Int
sofCLong = forall a. Storable a => a -> Int
sizeOf (CLong
0 :: CLong)
#if (MIN_VERSION_base(4,5,0))
toElapsedP :: CTime -> CLong -> ElapsedP
toElapsedP :: CTime -> CLong -> ElapsedP
toElapsedP (CTime Int64
sec) CLong
nsec = Elapsed -> NanoSeconds -> ElapsedP
ElapsedP (Seconds -> Elapsed
Elapsed forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
sec)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
nsec)
#else
toElapsedP :: CLong -> CLong -> ElapsedP
toElapsedP sec nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec)
#endif
systemGetElapsed :: IO Elapsed
systemGetElapsed :: IO Elapsed
systemGetElapsed = forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned Int
sofTimespec Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr CLong
ptr -> do
Ptr CLong -> IO ()
c_clock_get Ptr CLong
ptr
CTime -> Elapsed
toElapsed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr CLong
ptr)
where sofTimespec :: Int
sofTimespec = forall a. Storable a => a -> Int
sizeOf (CTime
0 :: CTime) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf (CLong
0 :: CLong)
#if (MIN_VERSION_base(4,5,0))
toElapsed :: CTime -> Elapsed
toElapsed :: CTime -> Elapsed
toElapsed (CTime Int64
sec) = Seconds -> Elapsed
Elapsed forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
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
rawGmTime :: Elapsed -> CTm
rawGmTime :: Elapsed -> CTm
rawGmTime (Elapsed (Seconds Int64
s)) = forall a. IO a -> a
unsafePerformIO IO CTm
callTime
where callTime :: IO CTm
callTime =
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CTm
ctmPtr -> do
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CTime
ctimePtr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CTime
ctimePtr CTime
ctime
Ptr CTm
r <- Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
c_gmtime_r Ptr CTime
ctimePtr Ptr CTm
ctmPtr
if Ptr CTm
r forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
then forall a. HasCallStack => [Char] -> a
error [Char]
"gmTime failed"
else forall a. Storable a => Ptr a -> IO a
peek Ptr CTm
ctmPtr
ctime :: CTime
ctime = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s
{-# NOINLINE rawGmTime #-}
localTime :: Elapsed -> IO CLong
localTime :: Elapsed -> IO CLong
localTime (Elapsed (Seconds Int64
s)) = IO CLong
callTime
where callTime :: IO CLong
callTime =
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CTm
ctmPtr -> do
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CTime
ctimePtr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CTime
ctimePtr CTime
ctime
Ptr CTm
r <- Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
c_localtime_r Ptr CTime
ctimePtr Ptr CTm
ctmPtr
if Ptr CTm
r forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
then forall a. HasCallStack => [Char] -> a
error [Char]
"localTime failed"
else forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CTm
ctmPtr Int
40
ctime :: CTime
ctime = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s
data CTm = CTm
{ CTm -> CInt
ctmSec :: CInt
, CTm -> CInt
ctmMin :: CInt
, CTm -> CInt
ctmHour :: CInt
, CTm -> CInt
ctmMDay :: CInt
, CTm -> CInt
ctmMon :: CInt
, CTm -> CInt
ctmYear :: CInt
} deriving (Int -> CTm -> ShowS
[CTm] -> ShowS
CTm -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CTm] -> ShowS
$cshowList :: [CTm] -> ShowS
show :: CTm -> [Char]
$cshow :: CTm -> [Char]
showsPrec :: Int -> CTm -> ShowS
$cshowsPrec :: Int -> CTm -> ShowS
Show,CTm -> CTm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CTm -> CTm -> Bool
$c/= :: CTm -> CTm -> Bool
== :: CTm -> CTm -> Bool
$c== :: CTm -> CTm -> Bool
Eq)
fromC :: CTm -> DateTime
fromC :: CTm -> DateTime
fromC CTm
ctm = Date -> TimeOfDay -> DateTime
DateTime Date
date TimeOfDay
time
where date :: Date
date = Date
{ dateYear :: Int
dateYear = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTm -> CInt
ctmYear CTm
ctm forall a. Num a => a -> a -> a
+ CInt
1900
, dateMonth :: Month
dateMonth = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTm -> CInt
ctmMon CTm
ctm
, dateDay :: Int
dateDay = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTm -> CInt
ctmMDay CTm
ctm
}
time :: TimeOfDay
time = TimeOfDay
{ todHour :: Hours
todHour = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTm -> CInt
ctmHour CTm
ctm
, todMin :: Minutes
todMin = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTm -> CInt
ctmMin CTm
ctm
, todSec :: Seconds
todSec = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTm -> CInt
ctmSec CTm
ctm
, todNSec :: NanoSeconds
todNSec = NanoSeconds
0
}
fromCP :: NanoSeconds -> CTm -> DateTime
fromCP :: NanoSeconds -> CTm -> DateTime
fromCP NanoSeconds
ns CTm
ctm = Date -> TimeOfDay -> DateTime
DateTime Date
d (TimeOfDay
t { todNSec :: NanoSeconds
todNSec = NanoSeconds
ns })
where (DateTime Date
d TimeOfDay
t) = CTm -> DateTime
fromC CTm
ctm
instance Storable CTm where
alignment :: CTm -> Int
alignment CTm
_ = Int
8
sizeOf :: CTm -> Int
sizeOf CTm
_ = Int
60
peek :: Ptr CTm -> IO CTm
peek Ptr CTm
ptr = do
CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CTm
CTm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff forall a. Ptr a
intPtr Int
0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff forall a. Ptr a
intPtr Int
4
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff forall a. Ptr a
intPtr Int
8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff forall a. Ptr a
intPtr Int
12
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff forall a. Ptr a
intPtr Int
16
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff forall a. Ptr a
intPtr Int
20
where intPtr :: Ptr b
intPtr = forall a b. Ptr a -> Ptr b
castPtr Ptr CTm
ptr
poke :: Ptr CTm -> CTm -> IO ()
poke Ptr CTm
ptr (CTm CInt
f0 CInt
f1 CInt
f2 CInt
f3 CInt
f4 CInt
f5) = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff forall a. Ptr a
intPtr))
[(Int
0,CInt
f0), (Int
4,CInt
f1), (Int
8,CInt
f2), (Int
12,CInt
f3), (Int
16,CInt
f4), (Int
20,CInt
f5)]
where intPtr :: Ptr b
intPtr = forall a b. Ptr a -> Ptr b
castPtr Ptr CTm
ptr