    -- | 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 -}

    -- * 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 = 1 Time -> Time -> Time
    forall a. Fractional a => a -> a -> a
    / 2Time -> Int -> Time
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(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 :: RealFrac n => n -> NTP64
    ntpr_to_ntpi :: n -> NTP64
    ntpr_to_ntpi t :: n
    t = n -> NTP64
    forall a b. (RealFrac a, Integral b) => a -> b
    round (n
    t n -> n -> n
    forall a. Num a => a -> a -> a
    * (2 n -> Int -> n
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (32::Int)))

    -- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.
    ntpi_to_ntpr :: Fractional n => NTP64 -> n
    ntpi_to_ntpr :: NTP64 -> n
    ntpi_to_ntpr t :: NTP64
    t = NTP64 -> n
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral NTP64
    t n -> n -> n
    forall a. Fractional a => a -> a -> a
    / 2n -> Int -> n
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(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 = (70 n -> n -> n
    forall a. Num a => a -> a -> a
    * 365 n -> n -> n
    forall a. Num a => a -> a -> a
    + 17) n -> n -> n
    forall a. Num a => a -> a -> a
    * 24 n -> n -> n
    forall a. Num a => a -> a -> a
    * 60 n -> n -> n
    forall a. Num a => a -> a -> a
    * 60

    -- | Convert a 'UT' timestamp to an 'NTPi' timestamp.
    ut_to_ntpi :: UT -> NTP64
    ut_to_ntpi :: Time -> NTP64
    ut_to_ntpi t :: Time
    t = Time -> NTP64
    forall n. RealFrac n => n -> 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
    forall n. Fractional n => NTP64 -> n
    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 1970 1 1
            s :: DiffTime
    s = Integer -> DiffTime
    T.secondsToDiffTime 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 t :: 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
    / 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
    n = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (n
    n n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > 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
    * 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 t :: 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
    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
    - 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 t :: 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 = "%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