{- | Osc related timing functions.
  Osc timestamps are 64-bit @Ntp@ values, <http://ntp.org/>.
-}
module Sound.Osc.Time where

import Data.Word {- base -}

import qualified Data.Time as Time {- time -}
import qualified Data.Time.Clock as Clock {- time -}
import qualified Data.Time.Clock.POSIX as Clock.Posix {- time -}

import Sound.Osc.Coding.Convert {- hosc -}

-- * Temporal types

{- | Type for binary (integeral) representation of a 64-bit Ntp timestamp (ie. ntpi).
  The Ntp epoch is January 1, 1900.
  Ntp v4 also includes a 128-bit format, which is not used by Osc.
-}
type Ntp64 = Word64

-- | @Ntp@ time in real-valued (fractional) form.
type NtpReal = Double

{- | @Unix/Posix@ time in real-valued (fractional) form.
  The Unix/Posix epoch is January 1, 1970.
-}
type PosixReal = Double

-- * Time conversion

{- | Convert an NtpReal timestamp to an Ntp64 timestamp.

>>> ntpr_to_ntpi 0
0

> fmap ntpr_to_ntpi time
-}
ntpr_to_ntpi :: NtpReal -> Ntp64
ntpr_to_ntpi :: PosixReal -> Ntp64
ntpr_to_ntpi PosixReal
t = PosixReal -> Ntp64
forall b. Integral b => PosixReal -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (PosixReal
t PosixReal -> PosixReal -> PosixReal
forall a. Num a => a -> a -> a
* (PosixReal
2 PosixReal -> Int -> PosixReal
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
32 :: Int)))

{- | Convert an 'Ntp64' timestamp to a real-valued Ntp timestamp.

>>> ntpi_to_ntpr 0
0.0
-}
ntpi_to_ntpr :: Ntp64 -> NtpReal
ntpi_to_ntpr :: Ntp64 -> PosixReal
ntpi_to_ntpr Ntp64
t = Ntp64 -> PosixReal
word64_to_double Ntp64
t PosixReal -> PosixReal -> PosixReal
forall a. Fractional a => a -> a -> a
/ PosixReal
2 PosixReal -> Int -> PosixReal
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
32 :: Int)

{- | Difference (in seconds) between /Ntp/ and /Posix/ epochs.

>>> ntp_posix_epoch_diff / (24 * 60 * 60)
25567.0

>>> 25567 `div` 365
70
-}
ntp_posix_epoch_diff :: Num n => n
ntp_posix_epoch_diff :: forall n. Num n => n
ntp_posix_epoch_diff = (n
70 n -> n -> n
forall a. Num a => a -> a -> a
* n
365 n -> n -> n
forall a. Num a => a -> a -> a
+ n
17) n -> n -> n
forall a. Num a => a -> a -> a
* n
24 n -> n -> n
forall a. Num a => a -> a -> a
* n
60 n -> n -> n
forall a. Num a => a -> a -> a
* n
60

-- | Convert a PosixReal timestamp to an Ntp64 timestamp.
posix_to_ntpi :: PosixReal -> Ntp64
posix_to_ntpi :: PosixReal -> Ntp64
posix_to_ntpi PosixReal
t = PosixReal -> Ntp64
ntpr_to_ntpi (PosixReal
t PosixReal -> PosixReal -> PosixReal
forall a. Num a => a -> a -> a
+ PosixReal
forall n. Num n => n
ntp_posix_epoch_diff)

-- | Convert @Unix/Posix@ to @Ntp@.
posix_to_ntpr :: Num n => n -> n
posix_to_ntpr :: forall n. Num n => n -> n
posix_to_ntpr = n -> n -> n
forall a. Num a => a -> a -> a
(+) n
forall n. Num n => n
ntp_posix_epoch_diff

-- | Convert @Ntp@ to @Unix/Posix@.
ntpr_to_posix :: Num n => n -> n
ntpr_to_posix :: forall n. Num n => n -> n
ntpr_to_posix = n -> n -> n
forall a. Num a => a -> a -> a
(+) (n -> n
forall n. Num n => n -> n
negate n
forall n. Num n => n
ntp_posix_epoch_diff)

-- | Convert 'Ntp64' to @Unix/Posix@.
ntpi_to_posix :: Ntp64 -> PosixReal
ntpi_to_posix :: Ntp64 -> PosixReal
ntpi_to_posix = PosixReal -> PosixReal
forall n. Num n => n -> n
ntpr_to_posix (PosixReal -> PosixReal)
-> (Ntp64 -> PosixReal) -> Ntp64 -> PosixReal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ntp64 -> PosixReal
ntpi_to_ntpr

-- | Convert 'Time' to 'Clock.Posix.POSIXTime'.
ntpr_to_posixtime :: NtpReal -> Clock.Posix.POSIXTime
ntpr_to_posixtime :: PosixReal -> POSIXTime
ntpr_to_posixtime = PosixReal -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (PosixReal -> POSIXTime)
-> (PosixReal -> PosixReal) -> PosixReal -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixReal -> PosixReal
forall n. Num n => n -> n
ntpr_to_posix

-- | Convert 'Clock.Posix.POSIXTime' to 'Time'.
posixtime_to_ntpr :: Clock.Posix.POSIXTime -> NtpReal
posixtime_to_ntpr :: POSIXTime -> PosixReal
posixtime_to_ntpr = PosixReal -> PosixReal
forall n. Num n => n -> n
posix_to_ntpr (PosixReal -> PosixReal)
-> (POSIXTime -> PosixReal) -> POSIXTime -> PosixReal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> PosixReal
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- * 'Data.Time' inter-operation.

-- | The time at 1970-01-01:00:00:00 which is the Unix/Posix epoch.
posix_epoch :: Time.UTCTime
posix_epoch :: UTCTime
posix_epoch =
  let d :: Day
d = Year -> Int -> Int -> Day
Time.fromGregorian Year
1970 Int
1 Int
1
      s :: DiffTime
s = Year -> DiffTime
forall a. Num a => Year -> a
fromInteger Year
0 -- Time.secondsToDiffTime
  in Day -> DiffTime -> UTCTime
Time.UTCTime Day
d DiffTime
s

-- | Convert 'Time.UTCTime' to @Unix/Posix@.
utc_to_posix :: Fractional n => Time.UTCTime -> n
utc_to_posix :: forall n. Fractional n => UTCTime -> n
utc_to_posix UTCTime
t = POSIXTime -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> POSIXTime
Time.diffUTCTime UTCTime
t UTCTime
posix_epoch)

-- * Clock operations

-- | utc_to_posix of Clock.getCurrentTime.
getCurrentTimeAsPosix :: IO PosixReal
getCurrentTimeAsPosix :: IO PosixReal
getCurrentTimeAsPosix = (UTCTime -> PosixReal) -> IO UTCTime -> IO PosixReal
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> PosixReal
forall n. Fractional n => UTCTime -> n
utc_to_posix IO UTCTime
Clock.getCurrentTime

{- | realToFrac of Clock.Posix.getPOSIXTime

> get_ct = getCurrentTimeAsPosix
> get_pt = getPosixTimeAsPosix
> (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1)
> print (pt - ct,pt - ct < 1e-5)
-}
getPosixTimeAsPosix :: IO PosixReal
getPosixTimeAsPosix :: IO PosixReal
getPosixTimeAsPosix = (POSIXTime -> PosixReal) -> IO POSIXTime -> IO PosixReal
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap POSIXTime -> PosixReal
forall a b. (Real a, Fractional b) => a -> b
realToFrac IO POSIXTime
Clock.Posix.getPOSIXTime

-- | Read current real-valued @Ntp@ timestamp.
currentTime :: IO NtpReal
currentTime :: IO PosixReal
currentTime = (POSIXTime -> PosixReal) -> IO POSIXTime -> IO PosixReal
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap POSIXTime -> PosixReal
posixtime_to_ntpr IO POSIXTime
Clock.Posix.getPOSIXTime