aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/contrib/external-tests/haskell/src/Data/Time/TAI64.hs
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/external-tests/haskell/src/Data/Time/TAI64.hs')
-rw-r--r--contrib/external-tests/haskell/src/Data/Time/TAI64.hs86
1 files changed, 86 insertions, 0 deletions
diff --git a/contrib/external-tests/haskell/src/Data/Time/TAI64.hs b/contrib/external-tests/haskell/src/Data/Time/TAI64.hs
new file mode 100644
index 0000000..37a90e6
--- /dev/null
+++ b/contrib/external-tests/haskell/src/Data/Time/TAI64.hs
@@ -0,0 +1,86 @@
+module Data.Time.TAI64 (
+ TAI64(..)
+ , TAI64N(..)
+ , TAI64NA(..)
+ , posixToTAI64
+ , posixToTAI64N
+ , posixToTAI64NA
+ , getCurrentTAI64
+ , getCurrentTAI64N
+ , getCurrentTAI64NA
+ , tAI64ToPosix
+ , tAI64NToPosix
+ , tAI64NAToPosix
+) where
+
+import Data.Serialize
+import Control.Monad
+import Data.Word
+
+import Data.Time.Clock
+import Data.Time.Clock.POSIX
+
+import Numeric
+
+data TAI64 = TAI64
+ {-# UNPACK #-} !Word64
+ deriving (Eq, Ord)
+
+data TAI64N = TAI64N
+ {-# UNPACK #-} !TAI64
+ {-# UNPACK #-} !Word32
+ deriving (Eq, Ord, Show)
+
+data TAI64NA = TAI64NA
+ {-# UNPACK #-} !TAI64N
+ {-# UNPACK #-} !Word32
+ deriving (Eq, Ord, Show)
+
+instance Show TAI64 where
+ show (TAI64 t) = "TAI64 0x" ++ showHex t ""
+
+instance Serialize TAI64 where
+ put (TAI64 t) = putWord64be t
+ get = liftM TAI64 get
+
+instance Serialize TAI64N where
+ put (TAI64N t' nt) = put t' >> putWord32be nt
+ get = liftM2 TAI64N get get
+
+instance Serialize TAI64NA where
+ put (TAI64NA t' at) = put t' >> putWord32be at
+ get = liftM2 TAI64NA get get
+
+
+posixToTAI64 :: POSIXTime -> TAI64
+posixToTAI64 = TAI64 . (2^62 +) . truncate . realToFrac
+
+posixToTAI64N :: POSIXTime -> TAI64N
+posixToTAI64N pt = TAI64N t' ns where
+ t' = posixToTAI64 pt
+ ns = (`mod` 10^9) $ truncate (pts * 10**9)
+ pts = realToFrac pt
+
+posixToTAI64NA :: POSIXTime -> TAI64NA -- | PICOsecond precision
+posixToTAI64NA pt = TAI64NA t' as where
+ t' = posixToTAI64N pt
+ as = (`mod` 10^9) $ truncate (pts * 10**18)
+ pts = realToFrac pt
+
+getCurrentTAI64 :: IO TAI64
+getCurrentTAI64N :: IO TAI64N
+getCurrentTAI64NA :: IO TAI64NA
+getCurrentTAI64 = liftM posixToTAI64 getPOSIXTime
+getCurrentTAI64N = liftM posixToTAI64N getPOSIXTime
+getCurrentTAI64NA = liftM posixToTAI64NA getPOSIXTime
+
+tAI64ToPosix :: TAI64 -> POSIXTime
+tAI64ToPosix (TAI64 s) = fromRational . fromIntegral $ s - 2^62
+
+tAI64NToPosix :: TAI64N -> POSIXTime
+tAI64NToPosix (TAI64N t' n) = tAI64ToPosix t' + nanopart where
+ nanopart = fromRational $ (toRational $ 10**(-9)) * toRational n -- TODO: optimize?
+
+tAI64NAToPosix :: TAI64NA -> POSIXTime
+tAI64NAToPosix (TAI64NA t' a) = tAI64NToPosix t' + attopart where
+ attopart = fromRational $ (toRational $ 10**(-18)) * toRational a