[commit: packages/time] format-widths, master, tasty: add taiClock (d04325a)

[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/d04325af1c5f202a38ddddcec0d6839ac7a94e15

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

commit d04325af1c5f202a38ddddcec0d6839ac7a94e15
Author: Ashley Yakeley <ashley at yakeley.org>
Date:   Wed Dec 14 01:36:20 2016 -0800

    add taiClock


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

d04325af1c5f202a38ddddcec0d6839ac7a94e15
 lib/Data/Time/Clock.hs         |  2 +-
 lib/Data/Time/Clock/GetTime.hs | 12 ++++++++----
 lib/Data/Time/Clock/TAI.hs     |  9 +++++++++
 test/Test/Resolution.hs        | 14 ++++++++++++--
 4 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/lib/Data/Time/Clock.hs b/lib/Data/Time/Clock.hs
index 7b38c5a..e971555 100644
--- a/lib/Data/Time/Clock.hs
+++ b/lib/Data/Time/Clock.hs
@@ -5,7 +5,7 @@ module Data.Time.Clock
     module Data.Time.Clock.UTC,
     module Data.Time.Clock.UTCDiff,
     getCurrentTime,
-    clockResolution
+    getTime_resolution
 ) where
 
 import Data.Time.Clock.Scale
diff --git a/lib/Data/Time/Clock/GetTime.hs b/lib/Data/Time/Clock/GetTime.hs
index 6cb50af..5ede677 100644
--- a/lib/Data/Time/Clock/GetTime.hs
+++ b/lib/Data/Time/Clock/GetTime.hs
@@ -58,7 +58,8 @@ instance NFData POSIXTime where
 
 
 getPOSIXTime :: IO POSIXTime
-clockResolution :: DiffTime
+getTime_resolution :: DiffTime
+getTAIRawTime :: Maybe (DiffTime,IO POSIXTime)
 
 #ifdef mingw32_HOST_OS
 -- On Windows, the equlvalent of POSIX time is "file time", defined as
@@ -73,7 +74,8 @@ getPOSIXTime = do
   where
     win32_epoch_adjust :: Word64
     win32_epoch_adjust = 116444736000000000
-clockResolution = 1E-6 -- microsecond
+getTime_resolution = 1E-6 -- microsecond
+getTAIRawTime = Nothing
 
 #elif HAVE_CLOCK_GETTIME
 -- Use hi-res clock_gettime
@@ -81,14 +83,16 @@ clockResolution = 1E-6 -- microsecond
 getPOSIXTime = do
     MkCTimespec (CTime s) (CLong ns) <- clockGetTime clock_REALTIME
     return (POSIXTime (fromIntegral s) (fromIntegral ns))
-clockResolution = case realtimeRes of
+getTime_resolution = case realtimeRes of
     MkCTimespec (CTime s) ns -> (fromIntegral s) + (fromIntegral ns) * 1E-9
+getTAIRawTime = Nothing
 
 #else
 -- Use gettimeofday
 getPOSIXTime = do
     MkCTimeval (CLong s) (CLong us) <- getCTimeval
     return (POSIXTime (fromIntegral s) (fromIntegral us * 1000))
-clockResolution = 1E-6 -- microsecond
+getTime_resolution = 1E-6 -- microsecond
+getTAIRawTime = Nothing
 
 #endif
diff --git a/lib/Data/Time/Clock/TAI.hs b/lib/Data/Time/Clock/TAI.hs
index dbde65f..dbda9a4 100644
--- a/lib/Data/Time/Clock/TAI.hs
+++ b/lib/Data/Time/Clock/TAI.hs
@@ -11,10 +11,13 @@ module Data.Time.Clock.TAI
 
     -- conversion between UTC and TAI with map
     utcDayLength,utcToTAITime,taiToUTCTime,
+
+    taiClock,
 ) where
 
 import Data.Time.LocalTime
 import Data.Time.Calendar.Days
+import Data.Time.Clock.GetTime
 import Data.Time.Clock
 import Control.DeepSeq
 import Data.Maybe
@@ -84,3 +87,9 @@ taiToUTCTime lsmap abstime = let
             day' = addDays (div' dtime len) day
         if day == day' then return (UTCTime day dtime) else stable day'
     in stable $ ModifiedJulianDay $ div' (diffAbsoluteTime abstime taiEpoch) 86400
+
+rawToTAITime :: POSIXTime -> AbsoluteTime
+rawToTAITime (POSIXTime s ns) = MkAbsoluteTime $ (fromIntegral s) + (fromIntegral ns) * 1E-9
+
+taiClock :: Maybe (DiffTime,IO AbsoluteTime)
+taiClock = fmap (fmap (fmap rawToTAITime)) getTAIRawTime
diff --git a/test/Test/Resolution.hs b/test/Test/Resolution.hs
index 579e14f..f9e9e3a 100644
--- a/test/Test/Resolution.hs
+++ b/test/Test/Resolution.hs
@@ -2,6 +2,7 @@ module Test.Resolution(testResolution) where
 
 import Data.Fixed
 import Data.Time.Clock
+import Data.Time.Clock.TAI
 import Test.TestUtil
 
 repeatN :: Monad m => Int -> m a -> m [a]
@@ -18,12 +19,21 @@ gcd' a b = gcd' b (mod' a b)
 gcdAll :: Real a => [a] -> a
 gcdAll = foldr gcd' 0
 
+testClockResolution :: Test
 testClockResolution = ioTest "getCurrentTime" $ do
     times <- repeatN 100 getCurrentTime
-    return $ assertionResult $ assertEqual "resolution" clockResolution $ gcdAll (fmap utctDayTime times)
+    return $ assertionResult $ assertEqual "resolution" getTime_resolution $ gcdAll (fmap utctDayTime times)
+
+testTAIResolution :: (DiffTime,IO AbsoluteTime) -> Test
+testTAIResolution (res,getTime) = ioTest "taiClock" $ do
+    times <- repeatN 100 getTime
+    return $ assertionResult $ assertEqual "resolution" res $ gcdAll (fmap (\t -> diffAbsoluteTime t taiEpoch) times)
 
 testResolution :: Test
-testResolution = testGroup "resolution"
+testResolution = testGroup "resolution" $
     [
     testClockResolution
     ]
+    ++ case taiClock of
+        Just clock -> [testTAIResolution clock]
+        Nothing -> []