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