-- |
-- 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 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 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 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

----------------------------------------------------------------------------------------
-- | return the current elapsedP
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 Int32
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 Int32
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

-- | return the current elapsed
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 Int32
sec) = Seconds -> Elapsed
Elapsed forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds (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

-- | 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)) = 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 #-}

-- | 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 =
            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

-- | 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]
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)

-- | 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  = 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
            }

-- | 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 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)]
        --pokeByteOff (castPtr ptr) 36 f9
      where intPtr :: Ptr b
intPtr = forall a b. Ptr a -> Ptr b
castPtr Ptr CTm
ptr