-- |
-- Module      : Data.Hourglass.Internal.Unix
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- 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 -> DateTime
dateTimeFromUnixEpochP (ElapsedP Elapsed
e NanoSeconds
ns) = NanoSeconds -> CTm -> DateTime
fromCP NanoSeconds
ns (CTm -> DateTime) -> CTm -> DateTime
forall a b. (a -> b) -> a -> b
$ Elapsed -> CTm
rawGmTime Elapsed
e

-- | convert a unix epoch to DateTime
dateTimeFromUnixEpoch :: Elapsed -> DateTime
dateTimeFromUnixEpoch :: Elapsed -> DateTime
dateTimeFromUnixEpoch Elapsed
e = CTm -> DateTime
fromC (CTm -> DateTime) -> CTm -> DateTime
forall a b. (a -> b) -> a -> b
$ Elapsed -> CTm
rawGmTime Elapsed
e

-- | return the timezone offset in minutes
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 CLong
60 (CLong -> TimezoneOffset) -> IO CLong -> IO TimezoneOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elapsed -> IO CLong
localTime Elapsed
0

----------------------------------------------------------------------------------------
-- | return the current elapsedP
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 Int
8 ((Ptr CLong -> IO ElapsedP) -> IO ElapsedP)
-> (Ptr CLong -> IO ElapsedP) -> IO ElapsedP
forall a b. (a -> b) -> a -> b
$ \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 (CTime
0 :: CTime)
        sofCLong :: Int
sofCLong = CLong -> Int
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 (Seconds -> Elapsed) -> Seconds -> Elapsed
forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
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

-- | return the current elapsed
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 Int
8 ((Ptr CLong -> IO Elapsed) -> IO Elapsed)
-> (Ptr CLong -> IO Elapsed) -> IO Elapsed
forall a b. (a -> b) -> a -> b
$ \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 (CTime
0 :: CTime) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CLong -> Int
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 (Seconds -> Elapsed) -> Seconds -> Elapsed
forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds (Int64 -> Int64
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

-- | Return a global time's struct tm based on the number of elapsed second since unix epoch.
rawGmTime :: Elapsed -> CTm
rawGmTime :: Elapsed -> CTm
rawGmTime (Elapsed (Seconds 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
$ \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
$ \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 [Char]
"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 #-}

-- | 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 -> IO CLong
localTime (Elapsed (Seconds 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
$ \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
$ \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 [Char]
"localTime failed"
                    else Ptr CTm -> Int -> IO CLong
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CTm
ctmPtr Int
40
        ctime :: CTime
ctime = Int64 -> CTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s

-- | Represent the beginning of struct tm
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)

-- | Convert a C structure to a DateTime structure
fromC :: CTm -> DateTime
fromC :: CTm -> DateTime
fromC CTm
ctm = Date -> TimeOfDay -> DateTime
DateTime Date
date TimeOfDay
time
  where date :: Date
date = Date :: 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
+ CInt
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 = TimeOfDay :: 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 = NanoSeconds
0
            }

-- | Similar to 'fromC' except with nanosecond precision
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 -- account for 9 ints, alignment + 2 unsigned long at end.
    peek :: Ptr CTm -> IO CTm
peek 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 Int
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 Int
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 Int
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 Int
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 Int
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 Int
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 CTm
ptr (CTm CInt
f0 CInt
f1 CInt
f2 CInt
f3 CInt
f4 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))
            [(Int
0,CInt
f0), (Int
4,CInt
f1), (Int
8,CInt
f2), (Int
12,CInt
f3), (Int
16,CInt
f4), (Int
20,CInt
f5)]
        --pokeByteOff (castPtr ptr) 36 f9
      where intPtr :: Ptr b
intPtr = Ptr CTm -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr CTm
ptr