[commit: packages/time] format-widths, master, tasty: get TAI clock working (e4ca1b0)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/time

On branches: format-widths,master,tasty
Link       : http://git.haskell.org/packages/time.git/commitdiff/e4ca1b0cbd79ce38acae7e647a1cfa2720a58ca9

>---------------------------------------------------------------

commit e4ca1b0cbd79ce38acae7e647a1cfa2720a58ca9
Author: Ashley Yakeley <ashley at yakeley.org>
Date:   Sat Dec 24 00:18:35 2016 -0800

    get TAI clock working


>---------------------------------------------------------------

e4ca1b0cbd79ce38acae7e647a1cfa2720a58ca9
 lib/Data/Time/Clock/Internal/CTimespec.hsc | 14 ++++++++------
 lib/Data/Time/Clock/Internal/SystemTime.hs | 26 +++++++++++++++++++-------
 lib/Data/Time/Clock/TAI.hs                 |  1 +
 3 files changed, 28 insertions(+), 13 deletions(-)

diff --git a/lib/Data/Time/Clock/Internal/CTimespec.hsc b/lib/Data/Time/Clock/Internal/CTimespec.hsc
index 74f6d64..38197a4 100644
--- a/lib/Data/Time/Clock/Internal/CTimespec.hsc
+++ b/lib/Data/Time/Clock/Internal/CTimespec.hsc
@@ -14,6 +14,8 @@ import System.IO.Unsafe
 
 #include <time.h>
 
+type ClockID = #{type clockid_t}
+
 data CTimespec = MkCTimespec CTime CLong
 
 instance Storable CTimespec where
@@ -28,9 +30,9 @@ instance Storable CTimespec where
         #{poke struct timespec, tv_nsec} p ns
 
 foreign import ccall unsafe "time.h clock_gettime"
-    clock_gettime :: #{type clockid_t} -> Ptr CTimespec -> IO CInt
+    clock_gettime :: ClockID -> Ptr CTimespec -> IO CInt
 foreign import ccall unsafe "time.h clock_getres"
-    clock_getres :: #{type clockid_t} -> Ptr CTimespec -> IO CInt
+    clock_getres :: ClockID -> Ptr CTimespec -> IO CInt
 
 -- | Get the resolution of the given clock.
 clockGetRes :: #{type clockid_t} -> IO (Either Errno CTimespec)
@@ -45,16 +47,16 @@ clockGetRes clockid = alloca $ \ptspec -> do
             return $ Left errno
 
 -- | Get the current time from the given clock.
-clockGetTime :: #{type clockid_t} -> IO CTimespec
+clockGetTime :: ClockID -> IO CTimespec
 clockGetTime clockid = alloca (\ptspec -> do
     throwErrnoIfMinus1_ "clock_gettime" $ clock_gettime clockid ptspec
     peek ptspec
     )
 
-clock_REALTIME :: #{type clockid_t}
+clock_REALTIME :: ClockID
 clock_REALTIME = #{const CLOCK_REALTIME}
 
-clock_TAI :: #{type clockid_t}
+clock_TAI :: ClockID
 clock_TAI = #{const 11}
 
 realtimeRes :: CTimespec
@@ -64,7 +66,7 @@ realtimeRes = unsafePerformIO $ do
         Left errno -> ioError (errnoToIOError "clock_getres" errno Nothing Nothing)
         Right res -> return res
 
-clockResolution :: #{type clockid_t} -> Maybe CTimespec
+clockResolution :: ClockID -> Maybe CTimespec
 clockResolution clockid = unsafePerformIO $ do
     mres <- clockGetRes clockid
     case mres of
diff --git a/lib/Data/Time/Clock/Internal/SystemTime.hs b/lib/Data/Time/Clock/Internal/SystemTime.hs
index 27d3d20..840e207 100644
--- a/lib/Data/Time/Clock/Internal/SystemTime.hs
+++ b/lib/Data/Time/Clock/Internal/SystemTime.hs
@@ -1,5 +1,11 @@
 {-# LANGUAGE Trustworthy #-}
-module Data.Time.Clock.Internal.SystemTime where
+module Data.Time.Clock.Internal.SystemTime
+    (
+    SystemTime(..),
+    getSystemTime,
+    getTime_resolution,
+    getTAISystemTime,
+    ) where
 
 import Data.Int (Int64)
 import Data.Word
@@ -60,12 +66,18 @@ getTAISystemTime = Nothing
 #elif HAVE_CLOCK_GETTIME
 -- Use hi-res clock_gettime
 
-getSystemTime = do
-    MkCTimespec (CTime s) (CLong ns) <- clockGetTime clock_REALTIME
-    return (MkSystemTime (fromIntegral s) (fromIntegral ns))
-getTime_resolution = case realtimeRes of
-    MkCTimespec (CTime s) ns -> (fromIntegral s) + (fromIntegral ns) * 1E-9
-getTAISystemTime = Nothing
+timespecToSystemTime :: CTimespec -> SystemTime
+timespecToSystemTime (MkCTimespec (CTime s) (CLong ns)) = (MkSystemTime (fromIntegral s) (fromIntegral ns))
+
+timespecToDiffTime :: CTimespec -> DiffTime
+timespecToDiffTime (MkCTimespec (CTime s) ns) = (fromIntegral s) + (fromIntegral ns) * 1E-9
+
+clockGetSystemTime :: ClockID -> IO SystemTime
+clockGetSystemTime clock = fmap timespecToSystemTime $ clockGetTime clock
+
+getSystemTime = clockGetSystemTime clock_REALTIME
+getTime_resolution = timespecToDiffTime realtimeRes
+getTAISystemTime = fmap (\resolution -> (timespecToDiffTime resolution,clockGetSystemTime clock_TAI)) $ clockResolution clock_TAI
 
 #else
 -- Use gettimeofday
diff --git a/lib/Data/Time/Clock/TAI.hs b/lib/Data/Time/Clock/TAI.hs
index 2613852..3336fd7 100644
--- a/lib/Data/Time/Clock/TAI.hs
+++ b/lib/Data/Time/Clock/TAI.hs
@@ -59,5 +59,6 @@ taiToUTCTime lsmap abstime = let
         if day == day' then return (UTCTime day dtime) else stable day'
     in stable $ ModifiedJulianDay $ div' (diffAbsoluteTime abstime taiEpoch) 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 = fmap (fmap (fmap systemToTAITime)) getTAISystemTime