new conversion functions timeToDaysAndTimeOfDay & daysAndTimeOfDayToTime
authorAshley Yakeley <ashley@semantic.org>
Mon, 15 Jan 2018 03:18:46 +0000 (19:18 -0800)
committerAshley Yakeley <ashley@semantic.org>
Mon, 15 Jan 2018 03:18:46 +0000 (19:18 -0800)
changelog.md
lib/Data/Time/LocalTime/Internal/TimeOfDay.hs
test/main/Main.hs
test/main/Test/Arbitrary.hs
test/main/Test/LocalTime/TimeOfDay.hs [new file with mode: 0644]
time.cabal

index 4fc0651..f545a72 100644 (file)
@@ -1,6 +1,7 @@
 # Change Log
 
 ## [1.9]
+- new conversion functions timeToDaysAndTimeOfDay & daysAndTimeOfDayToTime
 - new DayOfWeek type
 - new CalendarDiffDays type
 - new addLocalTime, diffLocalTime
index 4af1f89..e65dd41 100644 (file)
@@ -5,6 +5,7 @@ module Data.Time.LocalTime.Internal.TimeOfDay
 (
     -- * Time of day
     TimeOfDay(..),midnight,midday,makeTimeOfDayValid,
+    timeToDaysAndTimeOfDay,daysAndTimeOfDayToTime,
     utcToLocalTimeOfDay,localToUTCTimeOfDay,
     timeToTimeOfDay,timeOfDayToTime,
     dayFractionToTimeOfDay,timeOfDayToDayFraction
@@ -17,6 +18,7 @@ import Data.Fixed
 import Data.Data
 #endif
 import Data.Time.Clock.Internal.DiffTime
+import Data.Time.Clock.Internal.NominalDiffTime
 import Data.Time.Calendar.Private
 import Data.Time.LocalTime.Internal.TimeZone
 
@@ -61,6 +63,20 @@ makeTimeOfDayValid h m s = do
     _ <- clipValid 0 60.999999999999 s
     return (TimeOfDay h m s)
 
+-- | Convert a period of time into a count of days and a time of day since midnight.
+-- The time of day will never have a leap second.
+timeToDaysAndTimeOfDay :: NominalDiffTime -> (Integer,TimeOfDay)
+timeToDaysAndTimeOfDay dt = let
+    s = realToFrac dt
+    (m,ms) = divMod' s 60
+    (h,hm) = divMod' m 60
+    (d,dh) = divMod' h 24
+    in (d,TimeOfDay dh hm ms)
+
+-- | Convert a count of days and a time of day since midnight into a period of time.
+daysAndTimeOfDayToTime :: Integer -> TimeOfDay -> NominalDiffTime
+daysAndTimeOfDayToTime d (TimeOfDay dh hm ms) = (+) (realToFrac ms) $ (*) 60 $ (+) (realToFrac hm) $ (*) 60 $ (+) (realToFrac dh) $ (*) 24 $ realToFrac d
+
 -- | Convert a time of day in UTC to a time of day in some timezone, together with a day adjustment.
 utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
 utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where
index bd7dc09..31cdb1f 100644 (file)
@@ -17,6 +17,7 @@ import Test.Clock.TAI
 import Test.Format.Format
 import Test.Format.ParseTime
 import Test.LocalTime.Time
+import Test.LocalTime.TimeOfDay
 
 
 tests :: TestTree
@@ -43,7 +44,8 @@ tests = testGroup "Time" [
         testParseTime
         ],
     testGroup "LocalTime" [
-        testTime
+        testTime,
+        testTimeOfDay
         ]
     ]
 
index 43058c6..8896b3a 100644 (file)
@@ -44,6 +44,21 @@ instance Arbitrary DiffTime where
 instance CoArbitrary DiffTime where
     coarbitrary t = coarbitrary (fromEnum t)
 
+instance Arbitrary NominalDiffTime where
+    arbitrary = oneof [intSecs, fracSecs]
+      where
+        limit = 1000 * 86400
+        picofactor = 10 ^ (12 :: Int)
+        intSecs = liftM secondsToDiffTime' $ choose (negate limit, limit)
+        fracSecs = liftM picosecondsToDiffTime' $ choose (negate limit * picofactor, limit * picofactor)
+        secondsToDiffTime' :: Integer -> NominalDiffTime
+        secondsToDiffTime' = fromInteger
+        picosecondsToDiffTime' :: Integer -> NominalDiffTime
+        picosecondsToDiffTime' x = fromRational (x % 10 ^ (12 :: Int))
+
+instance CoArbitrary NominalDiffTime where
+    coarbitrary t = coarbitrary (fromEnum t)
+
 instance Arbitrary TimeOfDay where
     arbitrary = liftM timeToTimeOfDay arbitrary
 
diff --git a/test/main/Test/LocalTime/TimeOfDay.hs b/test/main/Test/LocalTime/TimeOfDay.hs
new file mode 100644 (file)
index 0000000..75fa07a
--- /dev/null
@@ -0,0 +1,22 @@
+module Test.LocalTime.TimeOfDay
+    ( testTimeOfDay
+    ) where
+
+import Data.Time.LocalTime
+import Test.Arbitrary ()
+import Test.Tasty
+import Test.Tasty.QuickCheck hiding (reason)
+
+testTimeOfDay :: TestTree
+testTimeOfDay =
+    testGroup
+        "TimeOfDay"
+        [ testProperty "daysAndTimeOfDayToTime . timeToDaysAndTimeOfDay" $ \ndt -> let
+              (d, tod) = timeToDaysAndTimeOfDay ndt
+              ndt' = daysAndTimeOfDayToTime d tod
+              in ndt' == ndt
+        , testProperty "timeOfDayToTime . timeToTimeOfDay" $ \dt -> let
+              tod = timeToTimeOfDay dt
+              dt' = timeOfDayToTime tod
+              in dt' == dt
+        ]
index a1e68dc..3e457dc 100644 (file)
@@ -162,6 +162,7 @@ test-suite test-main
         Test.Format.Format
         Test.Format.ParseTime
         Test.LocalTime.Time
+        Test.LocalTime.TimeOfDay
         Test.LocalTime.TimeRef
 
 test-suite test-unix