    {-# LANGUAGE CPP #-}
    {-# LANGUAGE Safe #-}

    {-# OPTIONS -fno-warn-orphans #-}

    -- | TAI and leap-second maps for converting to UTC: most people won't need this module.
    module Data.Time.Clock.TAI (
        -- * Absolute Time
        AbsoluteTime,
        taiEpoch,
        addAbsoluteTime,
        diffAbsoluteTime,
        taiNominalDayStart,

        -- * Leap-Second Map
        LeapSecondMap,
        utcDayLength,
        utcToTAITime,
        taiToUTCTime,
        taiClock,
    ) where

    import Data.Fixed
    import Data.Maybe
    import Data.Time.Calendar.Days
    import Data.Time.Clock
    import Data.Time.Clock.Internal.AbsoluteTime
    import Data.Time.Clock.Internal.SystemTime
    import Data.Time.Clock.System
    import Data.Time.LocalTime
    #ifdef __MHS__
    import Data.Tuple.Instances
    #endif

    instance Show AbsoluteTime where
        show :: AbsoluteTime -> String
    show AbsoluteTime
    t = LocalTime -> String
    forall a. Show a => a -> String
    show (TimeZone -> UTCTime -> LocalTime
    utcToLocalTime TimeZone
    utc (Maybe UTCTime -> UTCTime
    forall a. HasCallStack => Maybe a -> a
    fromJust (LeapSecondMap -> AbsoluteTime -> Maybe UTCTime
    taiToUTCTime (Maybe Int -> LeapSecondMap
    forall a b. a -> b -> a
    const (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    0)) AbsoluteTime
    t))) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " TAI" -- ugly, but standard apparently

    -- | TAI - UTC during this day.
    -- No table is provided, as any program compiled with it would become
    -- out of date in six months.
    type LeapSecondMap = Day -> Maybe Int

    utcDayLength :: LeapSecondMap -> Day -> Maybe DiffTime
    utcDayLength :: LeapSecondMap -> Day -> Maybe DiffTime
    utcDayLength LeapSecondMap
    lsmap Day
    day = do
        i0 <- LeapSecondMap
    lsmap Day
    day
        i1 <- lsmap $ addDays 1 day
        return $ realToFrac (86400 + i1 - i0)

    dayStart :: LeapSecondMap -> Day -> Maybe AbsoluteTime
    dayStart :: LeapSecondMap -> Day -> Maybe AbsoluteTime
    dayStart LeapSecondMap
    lsmap Day
    day = do
        i <- LeapSecondMap
    lsmap Day
    day
        return $ addAbsoluteTime (realToFrac $ (toModifiedJulianDay day) * 86400 + toInteger i) taiEpoch

    utcToTAITime :: LeapSecondMap -> UTCTime -> Maybe AbsoluteTime
    utcToTAITime :: LeapSecondMap -> UTCTime -> Maybe AbsoluteTime
    utcToTAITime LeapSecondMap
    lsmap (UTCTime Day
    day DiffTime
    dtime) = do
        t <- LeapSecondMap -> Day -> Maybe AbsoluteTime
    dayStart LeapSecondMap
    lsmap Day
    day
        return $ addAbsoluteTime dtime t

    taiToUTCTime :: LeapSecondMap -> AbsoluteTime -> Maybe UTCTime
    taiToUTCTime :: LeapSecondMap -> AbsoluteTime -> Maybe UTCTime
    taiToUTCTime LeapSecondMap
    lsmap AbsoluteTime
    abstime =
        let
            stable :: Day -> Maybe UTCTime
    stable Day
    day = do
                dayt <- LeapSecondMap -> Day -> Maybe AbsoluteTime
    dayStart LeapSecondMap
    lsmap Day
    day
                len <- utcDayLength lsmap day
                let
                    dtime = AbsoluteTime -> AbsoluteTime -> DiffTime
    diffAbsoluteTime AbsoluteTime
    abstime AbsoluteTime
    dayt
                    day' = Integer -> Day -> Day
    addDays (DiffTime -> DiffTime -> Integer
    forall a b. (Real a, Integral b) => a -> a -> b
    div' DiffTime
    dtime DiffTime
    len) Day
    day
                if day == day'
                    then return (UTCTime day dtime)
                    else stable day'
        in
            Day -> Maybe UTCTime
    stable (Day -> Maybe UTCTime) -> Day -> Maybe UTCTime
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day
    ModifiedJulianDay (Integer -> Day) -> Integer -> Day
    forall a b. (a -> b) -> a -> b
    $ DiffTime -> DiffTime -> Integer
    forall a b. (Real a, Integral b) => a -> a -> b
    div' (AbsoluteTime -> AbsoluteTime -> DiffTime
    diffAbsoluteTime AbsoluteTime
    abstime AbsoluteTime
    taiEpoch) DiffTime
    86400

    -- | TAI clock, if it exists. Note that it is unlikely to be set correctly, without due care and attention.
    taiClock :: Maybe (DiffTime, IO AbsoluteTime)
    taiClock :: Maybe (DiffTime, IO AbsoluteTime)
    taiClock = ((DiffTime, IO SystemTime) -> (DiffTime, IO AbsoluteTime))
    -> Maybe (DiffTime, IO SystemTime)
    -> Maybe (DiffTime, IO AbsoluteTime)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((IO SystemTime -> IO AbsoluteTime)
    -> (DiffTime, IO SystemTime) -> (DiffTime, IO AbsoluteTime)
    forall a b. (a -> b) -> (DiffTime, a) -> (DiffTime, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((SystemTime -> AbsoluteTime) -> IO SystemTime -> IO AbsoluteTime
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SystemTime -> AbsoluteTime
    systemToTAITime)) Maybe (DiffTime, IO SystemTime)
    getTAISystemTime