    -- |
    -- 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 a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr Any -> Int -> IO CLong
    forall b. Ptr b -> 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 b. Ptr b -> 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
    $cshowsPrec :: Int -> CTm -> ShowS
    showsPrec :: Int -> CTm -> ShowS
    $cshow :: CTm -> [Char]
    show :: CTm -> [Char]
    $cshowList :: [CTm] -> ShowS
    showList :: [CTm] -> ShowS
    Show,CTm -> CTm -> Bool
    (CTm -> CTm -> Bool) -> (CTm -> CTm -> Bool) -> Eq CTm
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CTm -> CTm -> Bool
    == :: CTm -> CTm -> Bool
    $c/= :: CTm -> CTm -> Bool
    /= :: 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
                { 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
                { 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 b. Ptr b -> 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 a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr Any -> Int -> IO CInt
    forall b. Ptr b -> 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 a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr Any -> Int -> IO CInt
    forall b. Ptr b -> 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 a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr Any -> Int -> IO CInt
    forall b. Ptr b -> 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 a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr Any -> Int -> IO CInt
    forall b. Ptr b -> 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 a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr Any -> Int -> IO CInt
    forall b. Ptr b -> 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 b. Ptr b -> 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