-- | System time
module Sound.Osc.Time.System where

import Data.Int {- base -}
import Data.Word {- base -}

import qualified Data.Time.Clock.System as Clock.System {- time >= 1.8 -}

import qualified Sound.Osc.Time as Time {- hosc -}

{- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored.
  getSystemTime is typically much faster than getCurrentTime, however it is not available in Hugs.
-}
getSystemTimeAsNtpReal :: IO Time.NtpReal
getSystemTimeAsNtpReal :: IO NtpReal
getSystemTimeAsNtpReal = do
  SystemTime
tm <- IO SystemTime
Clock.System.getSystemTime
  NtpReal -> IO NtpReal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> NtpReal
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SystemTime -> Int64
Clock.System.systemSeconds SystemTime
tm) NtpReal -> NtpReal -> NtpReal
forall a. Num a => a -> a -> a
+ (Word32 -> NtpReal
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SystemTime -> Word32
Clock.System.systemNanoseconds SystemTime
tm) NtpReal -> NtpReal -> NtpReal
forall a. Num a => a -> a -> a
* NtpReal
1.0e-9))

-- | System time with fractional part in microseconds (us) instead of nanoseconds (ns).
getSystemTimeInMicroseconds :: IO (Int64, Word32)
getSystemTimeInMicroseconds :: IO (Int64, Word32)
getSystemTimeInMicroseconds = do
  SystemTime
tm <- IO SystemTime
Clock.System.getSystemTime
  let sec :: Int64
sec = SystemTime -> Int64
Clock.System.systemSeconds SystemTime
tm
      usec :: Word32
usec = SystemTime -> Word32
Clock.System.systemNanoseconds SystemTime
tm Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
1000
  (Int64, Word32) -> IO (Int64, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
sec, Word32
usec)