{-# LINE 1 "src/Data/Thyme/Clock/POSIX.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}


{-# LINE 4 "src/Data/Thyme/Clock/POSIX.hsc" #-}


{-# LINE 6 "src/Data/Thyme/Clock/POSIX.hsc" #-}

-- | <https://en.wikipedia.org/wiki/Unix_time POSIX time>
module Data.Thyme.Clock.POSIX
    ( posixDayLength
    , POSIXTime
    , posixTime
    , getPOSIXTime

    -- * Compatibility
    , posixSecondsToUTCTime
    , utcTimeToPOSIXSeconds
    ) where

import Prelude
import Control.Lens
import Data.AdditiveGroup
import Data.Thyme.Internal.Micro
import Data.Thyme.Clock.Internal


{-# LINE 28 "src/Data/Thyme/Clock/POSIX.hsc" #-}
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.Types
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable

{-# LINE 34 "src/Data/Thyme/Clock/POSIX.hsc" #-}

-- | The nominal (ignoring leap seconds) time difference since midnight
-- 1970-01-01, the Unix epoch. Equvialent to a normalised
-- @<http://www.gnu.org/software/libc/manual/html_node/Elapsed-Time.html struct timeval>@.
type POSIXTime = NominalDiffTime

-- | "Control.Lens.Iso" between 'UTCTime' and 'POSIXTime'.
--
-- @
-- > 'getPOSIXTime'
-- 1459515013.527711s
-- > 'review' 'posixTime' '<$>' 'getPOSIXTime'
-- 2016-01-01 12:50:45.588729 UTC
-- @
{-# INLINE posixTime #-}
posixTime :: Iso' UTCTime POSIXTime
posixTime :: Iso' UTCTime POSIXTime
posixTime = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (UTCRep POSIXTime
t) -> POSIXTime
t forall v. AdditiveGroup v => v -> v -> v
^-^ POSIXTime
unixEpoch)
        (POSIXTime -> UTCTime
UTCRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. AdditiveGroup v => v -> v -> v
(^+^) POSIXTime
unixEpoch) where
    unixEpoch :: POSIXTime
unixEpoch = forall s t a b. AReview s t a b -> b -> t
review forall t. TimeDiff t => Iso' t Int64
microseconds forall a b. (a -> b) -> a -> b
$
        {-ModifiedJulianDay-}Int64
40587 forall a. Num a => a -> a -> a
* {-posixDayLength-}Int64
86400000000

-- | Return the current system POSIX time via
-- @<http://www.gnu.org/software/libc/manual/html_node/High_002dResolution-Calendar.html gettimeofday>@,
-- or @getSystemTimeAsFileTime@ on Windows.
-- 
-- See also 'Data.Thyme.Clock.getCurrentTime', 'Data.Thyme.LocalTime.getZonedTime'.
{-# INLINE getPOSIXTime #-}
getPOSIXTime :: IO POSIXTime

{-# LINE 75 "src/Data/Thyme/Clock/POSIX.hsc" #-}

getPOSIXTime :: IO POSIXTime
getPOSIXTime = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
16) forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptv -> do
{-# LINE 77 "src/Data/Thyme/Clock/POSIX.hsc" #-}
    throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptv nullPtr
    CTime sec <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptv
{-# LINE 79 "src/Data/Thyme/Clock/POSIX.hsc" #-}
    CSUSeconds usec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptv
{-# LINE 80 "src/Data/Thyme/Clock/POSIX.hsc" #-}
    return . NominalDiffTime . Micro $
        1000000 * fromIntegral sec + fromIntegral usec

foreign import ccall unsafe "time.h gettimeofday"
    gettimeofday :: Ptr () -> Ptr () -> IO CInt


{-# LINE 87 "src/Data/Thyme/Clock/POSIX.hsc" #-}

------------------------------------------------------------------------

-- | Construct a 'UTCTime' from a 'POSIXTime'.
--
-- @
-- 'posixSecondsToUTCTime' = 'review' 'posixTime'
-- 'posixSecondsToUTCTime' t ≡ 'posixTime' 'Control.Lens.#' t
-- @
{-# INLINE posixSecondsToUTCTime #-}
posixSecondsToUTCTime :: POSIXTime -> UTCTime
posixSecondsToUTCTime :: POSIXTime -> UTCTime
posixSecondsToUTCTime = forall s t a b. AReview s t a b -> b -> t
review Iso' UTCTime POSIXTime
posixTime

-- | Convert a 'UTCTime' to a 'POSIXTime'.
--
-- @
-- 'utcTimeToPOSIXSeconds' = 'view' 'posixTime'
-- @
{-# INLINE utcTimeToPOSIXSeconds #-}
utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime
utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime
utcTimeToPOSIXSeconds = forall a s. Getting a s a -> s -> a
view Iso' UTCTime POSIXTime
posixTime