{-# LANGUAGE Safe #-}
{-# OPTIONS -fno-warn-orphans #-}
module Data.Time.Clock.TAI (
module Data.Time.Clock.Internal.AbsoluteTime,
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
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"
type LeapSecondMap = Day -> Maybe Int
utcDayLength :: LeapSecondMap -> Day -> Maybe DiffTime
utcDayLength :: LeapSecondMap -> Day -> Maybe DiffTime
utcDayLength LeapSecondMap
lsmap Day
day = do
Int
i0 <- LeapSecondMap
lsmap Day
day
Int
i1 <- LeapSecondMap
lsmap LeapSecondMap -> LeapSecondMap
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
1 Day
day
DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffTime -> Maybe DiffTime) -> DiffTime -> Maybe DiffTime
forall a b. (a -> b) -> a -> b
$ Int -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int
86400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i0)
dayStart :: LeapSecondMap -> Day -> Maybe AbsoluteTime
dayStart :: LeapSecondMap -> Day -> Maybe AbsoluteTime
dayStart LeapSecondMap
lsmap Day
day = do
Int
i <- LeapSecondMap
lsmap Day
day
AbsoluteTime -> Maybe AbsoluteTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsoluteTime -> Maybe AbsoluteTime)
-> AbsoluteTime -> Maybe AbsoluteTime
forall a b. (a -> b) -> a -> b
$ DiffTime -> AbsoluteTime -> AbsoluteTime
addAbsoluteTime (Integer -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ (Day -> Integer
toModifiedJulianDay Day
day) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
86400 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i) AbsoluteTime
taiEpoch
utcToTAITime :: LeapSecondMap -> UTCTime -> Maybe AbsoluteTime
utcToTAITime :: LeapSecondMap -> UTCTime -> Maybe AbsoluteTime
utcToTAITime LeapSecondMap
lsmap (UTCTime Day
day DiffTime
dtime) = do
AbsoluteTime
t <- LeapSecondMap -> Day -> Maybe AbsoluteTime
dayStart LeapSecondMap
lsmap Day
day
AbsoluteTime -> Maybe AbsoluteTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsoluteTime -> Maybe AbsoluteTime)
-> AbsoluteTime -> Maybe AbsoluteTime
forall a b. (a -> b) -> a -> b
$ DiffTime -> AbsoluteTime -> AbsoluteTime
addAbsoluteTime DiffTime
dtime AbsoluteTime
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
AbsoluteTime
dayt <- LeapSecondMap -> Day -> Maybe AbsoluteTime
dayStart LeapSecondMap
lsmap Day
day
DiffTime
len <- LeapSecondMap -> Day -> Maybe DiffTime
utcDayLength LeapSecondMap
lsmap Day
day
let dtime :: DiffTime
dtime = AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime AbsoluteTime
abstime AbsoluteTime
dayt
day' :: Day
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 Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day
day'
then UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
dtime)
else Day -> Maybe UTCTime
stable Day
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
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