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

import Control.Concurrent {- base -}
import Control.Monad {- base -}
import Control.Monad.IO.Class {- transformers -}
import Data.Word {- base -}

import qualified Data.Time as T {- time -}
import qualified Data.Time.Clock.POSIX as T {- 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.
--   NTPv4 also includes a 128-bit format, which is not used by OSC.
type NTP64 = Word64

-- | @NTP@ time in real-valued (fractional) form (ie. @ntpr@).
--   This is the primary form of timestamp used by hosc.
type Time = Double

-- | Constant indicating a bundle to be executed immediately.
--   It has the NTP64 representation of @1@.
immediately :: Time
immediately :: Time
immediately = Time
1 Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
2Time -> Int -> Time
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32::Int)

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

-- * Time conversion

-- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp.
--
-- > ntpr_to_ntpi immediately == 1
-- > fmap ntpr_to_ntpi time
ntpr_to_ntpi :: Time -> NTP64
ntpr_to_ntpi :: Time -> NTP64
ntpr_to_ntpi Time
t = Time -> NTP64
forall a b. (RealFrac a, Integral b) => a -> b
round (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Time
2 Time -> Int -> Time
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
32::Int)))

-- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.
ntpi_to_ntpr :: NTP64 -> Time
ntpi_to_ntpr :: NTP64 -> Time
ntpi_to_ntpr NTP64
t = NTP64 -> Time
word64_to_double NTP64
t Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
2Time -> Int -> Time
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32::Int)

-- | Difference (in seconds) between /NTP/ and /UT/ epochs.
--
-- > ntp_ut_epoch_diff / (24 * 60 * 60) == 25567
-- > 25567 `div` 365 == 70
ntp_ut_epoch_diff :: Num n => n
ntp_ut_epoch_diff :: n
ntp_ut_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 'UT' timestamp to an 'NTPi' timestamp.
ut_to_ntpi :: UT -> NTP64
ut_to_ntpi :: Time -> NTP64
ut_to_ntpi Time
t = Time -> NTP64
ntpr_to_ntpi (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
forall n. Num n => n
ntp_ut_epoch_diff)

-- | Convert @Unix/Posix@ to @NTP@.
ut_to_ntpr :: Num n => n -> n
ut_to_ntpr :: n -> n
ut_to_ntpr = n -> n -> n
forall a. Num a => a -> a -> a
(+) n
forall n. Num n => n
ntp_ut_epoch_diff

-- | Convert @NTP@ to @Unix/Posix@.
ntpr_to_ut :: Num n => n -> n
ntpr_to_ut :: n -> n
ntpr_to_ut = n -> n -> n
forall a. Num a => a -> a -> a
(+) (n -> n
forall a. Num a => a -> a
negate n
forall n. Num n => n
ntp_ut_epoch_diff)

-- | Convert 'NTPi' to @Unix/Posix@.
ntpi_to_ut :: NTP64 -> UT
ntpi_to_ut :: NTP64 -> Time
ntpi_to_ut = Time -> Time
forall a. Num a => a -> a
ntpr_to_ut (Time -> Time) -> (NTP64 -> Time) -> NTP64 -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTP64 -> Time
ntpi_to_ntpr

-- | Convert 'Time' to 'T.POSIXTime'.
ntpr_to_posixtime :: Time -> T.POSIXTime
ntpr_to_posixtime :: Time -> POSIXTime
ntpr_to_posixtime = Time -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Time -> POSIXTime) -> (Time -> Time) -> Time -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Time
forall a. Num a => a -> a
ntpr_to_ut

-- | Convert 'T.POSIXTime' to 'Time'.
posixtime_to_ntpr :: T.POSIXTime -> Time
posixtime_to_ntpr :: POSIXTime -> Time
posixtime_to_ntpr = Time -> Time
forall a. Num a => a -> a
ut_to_ntpr (Time -> Time) -> (POSIXTime -> Time) -> POSIXTime -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac

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

-- | The time at 1970-01-01:00:00:00.
ut_epoch :: T.UTCTime
ut_epoch :: UTCTime
ut_epoch =
    let d :: Day
d = Integer -> Int -> Int -> Day
T.fromGregorian Integer
1970 Int
1 Int
1
        s :: DiffTime
s = Integer -> DiffTime
T.secondsToDiffTime Integer
0
    in Day -> DiffTime -> UTCTime
T.UTCTime Day
d DiffTime
s

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

-- * Clock operations

{- | Read current real-valued @NTP@ timestamp.

> get_ct = fmap utc_to_ut T.getCurrentTime
> get_pt = fmap realToFrac T.getPOSIXTime
> (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1)
> print (pt - ct,pt - ct < 1e-5)

-}
time :: MonadIO m => m Time
time :: m Time
time = IO Time -> m Time
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((POSIXTime -> Time) -> IO POSIXTime -> IO Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap POSIXTime -> Time
posixtime_to_ntpr IO POSIXTime
T.getPOSIXTime)

-- * Thread operations.

-- | The 'pauseThread' limit (in seconds).
--   Values larger than this require a different thread delay mechanism, see 'sleepThread'.
--   The value is the number of microseconds in @maxBound::Int@.
pauseThreadLimit :: Fractional n => n
pauseThreadLimit :: n
pauseThreadLimit = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound::Int) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
1e6

-- | Pause current thread for the indicated duration (in seconds), see 'pauseThreadLimit'.
pauseThread :: (MonadIO m,RealFrac n) => n -> m ()
pauseThread :: n -> m ()
pauseThread n
n = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (n
n n -> n -> n
forall a. Num a => a -> a -> a
* n
1e6))))

-- | Type restricted 'pauseThread'.
wait :: MonadIO m => Double -> m ()
wait :: Time -> m ()
wait = Time -> m ()
forall (m :: * -> *) n. (MonadIO m, RealFrac n) => n -> m ()
pauseThread

-- | Pause current thread until the given 'Time', see 'pauseThreadLimit'.
pauseThreadUntil :: MonadIO m => Time -> m ()
pauseThreadUntil :: Time -> m ()
pauseThreadUntil Time
t = Time -> m ()
forall (m :: * -> *) n. (MonadIO m, RealFrac n) => n -> m ()
pauseThread (Time -> m ()) -> (Time -> Time) -> Time -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
-) (Time -> m ()) -> m Time -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Time
forall (m :: * -> *). MonadIO m => m Time
time

-- | Sleep current thread for the indicated duration (in seconds).
--   Divides long sleeps into parts smaller than 'pauseThreadLimit'.
sleepThread :: (RealFrac n, MonadIO m) => n -> m ()
sleepThread :: n -> m ()
sleepThread n
n =
    if n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
forall n. Fractional n => n
pauseThreadLimit
    then let n' :: n
n' = n
forall n. Fractional n => n
pauseThreadLimit n -> n -> n
forall a. Num a => a -> a -> a
- n
1
         in n -> m ()
forall (m :: * -> *) n. (MonadIO m, RealFrac n) => n -> m ()
pauseThread n
n m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> n -> m ()
forall n (m :: * -> *). (RealFrac n, MonadIO m) => n -> m ()
sleepThread (n
n n -> n -> n
forall a. Num a => a -> a -> a
- n
n')
    else n -> m ()
forall (m :: * -> *) n. (MonadIO m, RealFrac n) => n -> m ()
pauseThread n
n

-- | Sleep current thread until the given 'Time'.
--   Divides long sleeps into parts smaller than 'pauseThreadLimit'.
sleepThreadUntil :: MonadIO m => Time -> m ()
sleepThreadUntil :: Time -> m ()
sleepThreadUntil Time
t = Time -> m ()
forall n (m :: * -> *). (RealFrac n, MonadIO m) => n -> m ()
sleepThread (Time -> m ()) -> (Time -> Time) -> Time -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
-) (Time -> m ()) -> m Time -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Time
forall (m :: * -> *). MonadIO m => m Time
time

-- * Pretty printing

-- | Detailed 37-character ISO 8601 format, including fractional seconds and '+0000' suffix.
iso_8601_fmt :: String
iso_8601_fmt :: String
iso_8601_fmt = String
"%Y-%m-%dT%H:%M:%S,%q+0000"

-- | Parse time according to 'iso_8601_fmt'
--
-- > iso_8601_to_utctime "2015-11-26T00:29:37,145875000000+0000"
iso_8601_to_utctime :: String -> Maybe T.UTCTime
iso_8601_to_utctime :: String -> Maybe UTCTime
iso_8601_to_utctime = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
T.parseTimeM Bool
True TimeLocale
T.defaultTimeLocale String
iso_8601_fmt

-- | UTC time in 'iso_8601_fmt'.
--
-- > tm <- fmap (utctime_to_iso_8601 . T.posixSecondsToUTCTime) T.getPOSIXTime
-- > (length tm,sum [4+1+2+1+2,1,2+1+2+1+2,1,12,1,4],sum [10,1,8,1,12,1,4]) == (37,37,37)
utctime_to_iso_8601 :: T.UTCTime -> String
utctime_to_iso_8601 :: UTCTime -> String
utctime_to_iso_8601 = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
T.formatTime TimeLocale
T.defaultTimeLocale String
iso_8601_fmt

-- | ISO 8601 of 'Time'.
--
-- > tm <- fmap ntpr_to_iso_8601 time
-- > import System.Process {- process -}
-- > rawSystem "date" ["-d",tm]
--
-- > t = 15708783354150518784
-- > s = "2015-11-26T00:22:19,366058349609+0000"
-- > ntpr_to_iso_8601 (ntpi_to_ntpr t) == s
ntpr_to_iso_8601 :: Time -> String
ntpr_to_iso_8601 :: Time -> String
ntpr_to_iso_8601 = UTCTime -> String
utctime_to_iso_8601 (UTCTime -> String) -> (Time -> UTCTime) -> Time -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
T.posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (Time -> POSIXTime) -> Time -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> POSIXTime
ntpr_to_posixtime

-- | 'Time' of ISO 8601.
--
-- > t = 15708783354150518784
-- > s = "2015-11-26T00:22:19,366058349609+0000"
-- > fmap ntpr_to_ntpi (iso_8601_to_ntpr s) == Just t
iso_8601_to_ntpr :: String -> Maybe Time
iso_8601_to_ntpr :: String -> Maybe Time
iso_8601_to_ntpr = (UTCTime -> Time) -> Maybe UTCTime -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime -> Time
posixtime_to_ntpr (POSIXTime -> Time) -> (UTCTime -> POSIXTime) -> UTCTime -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
T.utcTimeToPOSIXSeconds) (Maybe UTCTime -> Maybe Time)
-> (String -> Maybe UTCTime) -> String -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UTCTime
iso_8601_to_utctime

-- | Alias for 'ntpr_to_iso_8601'.
--
-- > time_pp immediately == "1900-01-01T00:00:00,000000000000+0000"
-- > fmap time_pp time
time_pp :: Time -> String
time_pp :: Time -> String
time_pp = Time -> String
ntpr_to_iso_8601