{-# LANGUAGE CPP #-}

#include "HsTimeConfig.h"

#if defined(mingw32_HOST_OS) || !defined(HAVE_CLOCK_GETTIME)
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif

module Data.Time.Clock.Internal.SystemTime (
    SystemTime (..),
    getSystemTime,
    getTime_resolution,
    getTAISystemTime,
) where

import Control.DeepSeq
import Data.Data
import Data.Int (Int64)
import Data.Time.Clock.Internal.DiffTime
import Data.Word

#ifdef mingw32_HOST_OS
import qualified System.Win32.Time as Win32
#elif defined(HAVE_CLOCK_GETTIME)
import Data.Time.Clock.Internal.CTimespec
import Foreign.C.Types (CLong(..), CTime(..))
#else
import Data.Time.Clock.Internal.CTimeval
import Foreign.C.Types (CLong(..))
#endif
--------------------------------------------------------------------------------

-- | 'SystemTime' is time returned by system clock functions.
-- Its semantics depends on the clock function, but the epoch is typically the beginning of 1970.
-- Note that 'systemNanoseconds' of 1E9 to 2E9-1 can be used to represent leap seconds.
data SystemTime = MkSystemTime
    { SystemTime -> Int64
systemSeconds :: {-# UNPACK #-} !Int64
    , SystemTime -> Word32
systemNanoseconds :: {-# UNPACK #-} !Word32
    }
    deriving (SystemTime -> SystemTime -> Bool
(SystemTime -> SystemTime -> Bool)
-> (SystemTime -> SystemTime -> Bool) -> Eq SystemTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SystemTime -> SystemTime -> Bool
== :: SystemTime -> SystemTime -> Bool
$c/= :: SystemTime -> SystemTime -> Bool
/= :: SystemTime -> SystemTime -> Bool
Eq, Eq SystemTime
Eq SystemTime =>
(SystemTime -> SystemTime -> Ordering)
-> (SystemTime -> SystemTime -> Bool)
-> (SystemTime -> SystemTime -> Bool)
-> (SystemTime -> SystemTime -> Bool)
-> (SystemTime -> SystemTime -> Bool)
-> (SystemTime -> SystemTime -> SystemTime)
-> (SystemTime -> SystemTime -> SystemTime)
-> Ord SystemTime
SystemTime -> SystemTime -> Bool
SystemTime -> SystemTime -> Ordering
SystemTime -> SystemTime -> SystemTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SystemTime -> SystemTime -> Ordering
compare :: SystemTime -> SystemTime -> Ordering
$c< :: SystemTime -> SystemTime -> Bool
< :: SystemTime -> SystemTime -> Bool
$c<= :: SystemTime -> SystemTime -> Bool
<= :: SystemTime -> SystemTime -> Bool
$c> :: SystemTime -> SystemTime -> Bool
> :: SystemTime -> SystemTime -> Bool
$c>= :: SystemTime -> SystemTime -> Bool
>= :: SystemTime -> SystemTime -> Bool
$cmax :: SystemTime -> SystemTime -> SystemTime
max :: SystemTime -> SystemTime -> SystemTime
$cmin :: SystemTime -> SystemTime -> SystemTime
min :: SystemTime -> SystemTime -> SystemTime
Ord, Int -> SystemTime -> ShowS
[SystemTime] -> ShowS
SystemTime -> String
(Int -> SystemTime -> ShowS)
-> (SystemTime -> String)
-> ([SystemTime] -> ShowS)
-> Show SystemTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SystemTime -> ShowS
showsPrec :: Int -> SystemTime -> ShowS
$cshow :: SystemTime -> String
show :: SystemTime -> String
$cshowList :: [SystemTime] -> ShowS
showList :: [SystemTime] -> ShowS
Show, Typeable SystemTime
Typeable SystemTime =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SystemTime -> c SystemTime)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SystemTime)
-> (SystemTime -> Constr)
-> (SystemTime -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SystemTime))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SystemTime))
-> ((forall b. Data b => b -> b) -> SystemTime -> SystemTime)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SystemTime -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SystemTime -> r)
-> (forall u. (forall d. Data d => d -> u) -> SystemTime -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SystemTime -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SystemTime -> m SystemTime)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SystemTime -> m SystemTime)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SystemTime -> m SystemTime)
-> Data SystemTime
SystemTime -> Constr
SystemTime -> DataType
(forall b. Data b => b -> b) -> SystemTime -> SystemTime
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SystemTime -> u
forall u. (forall d. Data d => d -> u) -> SystemTime -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SystemTime -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SystemTime -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SystemTime
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SystemTime -> c SystemTime
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SystemTime)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SystemTime)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SystemTime -> c SystemTime
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SystemTime -> c SystemTime
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SystemTime
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SystemTime
$ctoConstr :: SystemTime -> Constr
toConstr :: SystemTime -> Constr
$cdataTypeOf :: SystemTime -> DataType
dataTypeOf :: SystemTime -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SystemTime)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SystemTime)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SystemTime)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SystemTime)
$cgmapT :: (forall b. Data b => b -> b) -> SystemTime -> SystemTime
gmapT :: (forall b. Data b => b -> b) -> SystemTime -> SystemTime
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SystemTime -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SystemTime -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SystemTime -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SystemTime -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SystemTime -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SystemTime -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SystemTime -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SystemTime -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemTime -> m SystemTime
Data, Typeable)

instance NFData SystemTime where
    rnf :: SystemTime -> ()
rnf SystemTime
a = SystemTime
a SystemTime -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored.
-- 'getSystemTime' is typically much faster than 'getCurrentTime'.
getSystemTime :: IO SystemTime

-- | The resolution of 'getSystemTime', 'getCurrentTime', 'getPOSIXTime'.
-- On UNIX systems this uses @clock_getres@, which may be <https://github.com/microsoft/WSL/issues/6029 wrong on WSL2>.
getTime_resolution :: DiffTime

-- | If supported, get TAI time, epoch start of 1970 TAI, with resolution.
-- This is supported only on UNIX systems, and only those with CLOCK_TAI available at run-time.
getTAISystemTime :: Maybe (DiffTime, IO SystemTime)

#ifdef mingw32_HOST_OS
-- On Windows, the equivalent of POSIX time is "file time", defined as
-- the number of 100-nanosecond intervals that have elapsed since
-- 12:00 A.M. January 1, 1601 (UTC).  We can convert this into a POSIX
-- time by adjusting the offset to be relative to the POSIX epoch.
getSystemTime = do
    Win32.FILETIME ft <- Win32.getSystemTimeAsFileTime
    let (s, us) = (ft - win32_epoch_adjust) `divMod` 10000000
    return (MkSystemTime (fromIntegral s) (fromIntegral us * 100))
  where
    win32_epoch_adjust :: Word64
    win32_epoch_adjust = 116444736000000000

getTime_resolution = 100E-9 -- 100ns

getTAISystemTime = Nothing
#elif defined(HAVE_CLOCK_GETTIME)
-- Use hi-res clock_gettime
timespecToSystemTime :: CTimespec -> SystemTime
timespecToSystemTime :: CTimespec -> SystemTime
timespecToSystemTime (MkCTimespec (CTime Int64
s) (CLong Int64
ns)) = (Int64 -> Word32 -> SystemTime
MkSystemTime (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s) (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ns))

timespecToDiffTime :: CTimespec -> DiffTime
timespecToDiffTime :: CTimespec -> DiffTime
timespecToDiffTime (MkCTimespec (CTime Int64
s) CLong
ns) = (Int64 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ (CLong -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
ns) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
1E-9

clockGetSystemTime :: ClockID -> IO SystemTime
clockGetSystemTime :: ClockID -> IO SystemTime
clockGetSystemTime ClockID
clock = (CTimespec -> SystemTime) -> IO CTimespec -> IO SystemTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CTimespec -> SystemTime
timespecToSystemTime (IO CTimespec -> IO SystemTime) -> IO CTimespec -> IO SystemTime
forall a b. (a -> b) -> a -> b
$ ClockID -> IO CTimespec
clockGetTime ClockID
clock

getSystemTime :: IO SystemTime
getSystemTime = ClockID -> IO SystemTime
clockGetSystemTime ClockID
clock_REALTIME

getTime_resolution :: DiffTime
getTime_resolution = CTimespec -> DiffTime
timespecToDiffTime CTimespec
realtimeRes

getTAISystemTime :: Maybe (DiffTime, IO SystemTime)
getTAISystemTime = do
    ClockID
clockID <- Maybe ClockID
clock_TAI
    CTimespec
resolution <- ClockID -> Maybe CTimespec
clockResolution ClockID
clockID
    (DiffTime, IO SystemTime) -> Maybe (DiffTime, IO SystemTime)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((DiffTime, IO SystemTime) -> Maybe (DiffTime, IO SystemTime))
-> (DiffTime, IO SystemTime) -> Maybe (DiffTime, IO SystemTime)
forall a b. (a -> b) -> a -> b
$ (CTimespec -> DiffTime
timespecToDiffTime CTimespec
resolution, ClockID -> IO SystemTime
clockGetSystemTime ClockID
clockID)
#else
-- Use gettimeofday
getSystemTime = do
    MkCTimeval (CLong s) (CLong us) <- getCTimeval
    return (MkSystemTime (fromIntegral s) (fromIntegral us * 1000))

getTime_resolution = 1E-6 -- microsecond

getTAISystemTime = Nothing
#endif