formatting: diff types (NominalDiffTime, DiffTime, CalendarDiffDays, CalendarDiffTime...
authorAshley Yakeley <ashley@semantic.org>
Tue, 16 Jan 2018 09:30:55 +0000 (01:30 -0800)
committerAshley Yakeley <ashley@semantic.org>
Tue, 16 Jan 2018 09:30:55 +0000 (01:30 -0800)
changelog.md
lib/Data/Time/Format.hs
test/main/Test/Format/Format.hs

index 03d8a4c..f835027 100644 (file)
@@ -5,6 +5,7 @@
 - new DayOfWeek type
 - new CalendarDiffDays and CalendarDiffTime types
 - new addLocalTime, diffLocalTime
+- formatting: diff types (NominalDiffTime, DiffTime, CalendarDiffDays, CalendarDiffTime)
 - formatting: %Ez and %EZ for ±HH:MM format
 - parseTimeM: use MonadFail constraint when supported
 - parsing: reject invalid (and empty) time-zones with %z and %Z
index 14f0256..256cd70 100644 (file)
@@ -9,15 +9,19 @@ import Data.Maybe
 import Data.Char
 import Data.Fixed
 
+import Data.Time.Clock.Internal.DiffTime
+import Data.Time.Clock.Internal.NominalDiffTime
 import Data.Time.Clock.Internal.UniversalTime
 import Data.Time.Clock.Internal.UTCTime
 import Data.Time.Clock.POSIX
 import Data.Time.Calendar.Days
+import Data.Time.Calendar.CalendarDiffDays
 import Data.Time.Calendar.Gregorian
 import Data.Time.Calendar.Week
 import Data.Time.Calendar.WeekDate
 import Data.Time.Calendar.OrdinalDate
 import Data.Time.Calendar.Private
+import Data.Time.LocalTime.Internal.CalendarDiffTime
 import Data.Time.LocalTime.Internal.TimeZone
 import Data.Time.LocalTime.Internal.TimeOfDay
 import Data.Time.LocalTime.Internal.LocalTime
@@ -215,6 +219,75 @@ formatChar c = case formatCharacter c of
 -- [@%U@] week of year where weeks start on Sunday (as 'sundayStartWeek'), 0-padded to two chars, @00@ - @53@
 --
 -- [@%W@] week of year where weeks start on Monday (as 'mondayStartWeek'), 0-padded to two chars, @00@ - @53@
+--
+-- == Duration types
+-- The specifiers for 'DiffTime', 'NominalDiffTime', 'CalendarDiffDays', and 'CalendarDiffTime' are semantically
+-- separate from the other types.
+-- Specifiers on negative time differences will generally be negative (think 'rem' rather than 'mod').
+--
+-- === 'NominalDiffTime' and 'DiffTime'
+-- Note that a "minute" of 'DiffTime' is simply 60 SI seconds, rather than a minute of civil time.
+-- Use 'NominalDiffTime' to work with civil time, ignoring any leap seconds.
+--
+-- For 'NominalDiffTime' and 'DiffTime':
+--
+-- [@%W@] total weeks
+--
+-- [@%D@] total days
+--
+-- [@%d@] days of week
+--
+-- [@%H@] total hours
+--
+-- [@%h@] hours of day
+--
+-- [@%M@] total minutes
+--
+-- [@%m@] minutes of hour
+--
+-- [@%S@] total seconds
+--
+-- [@%s@] seconds of minute
+--
+-- [@%q@] picosecond of second, 0-padded to twelve chars, @000000000000@ - @999999999999@.
+--
+-- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros.
+-- For a whole number of seconds, @%Q@ omits the decimal point unless padding is specified.
+--
+-- === 'CalendarDiffDays'
+-- For 'CalendarDiffDays' (and 'CalendarDiffTime'):
+--
+-- [@%Y@] total years
+--
+-- [@%B@] total months
+--
+-- [@%b@] months of year
+--
+-- [@%W@] total weeks, not including months
+--
+-- [@%D@] total days, not including months
+--
+-- === 'CalendarDiffTime'
+-- For 'CalendarDiffTime':
+--
+-- [@%d@] days of week
+--
+-- [@%H@] total hours, not including months
+--
+-- [@%h@] hours of day
+--
+-- [@%M@] total minutes, not including months
+--
+-- [@%m@] minutes of hour
+--
+-- [@%S@] total seconds, not including months
+--
+-- [@%s@] seconds of minute
+--
+-- [@%q@] picosecond of second, 0-padded to twelve chars, @000000000000@ - @999999999999@.
+--
+-- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros.
+-- For a whole number of seconds, @%Q@ omits the decimal point unless padding is specified.
 formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String
 formatTime _ [] _ = ""
 formatTime locale ('%':cs) t = case formatTime1 locale cs t of
@@ -376,3 +449,60 @@ instance FormatTime UTCTime where
 
 instance FormatTime UniversalTime where
     formatCharacter c = fmap (\f fo t -> f fo (ut1ToLocalTime 0 t)) (formatCharacter c)
+
+padNumStd :: Int -> (t -> Integer) -> (FormatOptions -> t -> String)
+padNumStd n = padNum False n '0'
+
+quotBy :: Real t => t -> t -> Integer
+quotBy d n = truncate ((toRational n) / (toRational d))
+
+remBy :: Real t => t -> t -> t
+remBy d n = n - (fromInteger f) * d where
+    f = quotBy d n
+
+instance FormatTime NominalDiffTime where
+    formatCharacter 'W' = Just $ padNumStd 1 $ quotBy $ 7 * 86400
+    formatCharacter 'D' = Just $ padNumStd 1 $ quotBy 86400
+    formatCharacter 'd' = Just $ padNumStd 1 $ remBy 7 . quotBy 86400
+    formatCharacter 'H' = Just $ padNumStd 1 $ quotBy 3600
+    formatCharacter 'h' = Just $ padNumStd 2 $ remBy 24 . quotBy 3600
+    formatCharacter 'M' = Just $ padNumStd 1 $ quotBy 60
+    formatCharacter 'm' = Just $ padNumStd 2 $ remBy 60 . quotBy 60
+    formatCharacter 'S' = Just $ padNumStd 1 $ quotBy 1
+    formatCharacter 's' = Just $ padNumStd 2 $ remBy 60 . quotBy 1
+    formatCharacter 'q' = Just $ padGeneral True True 12 '0' $ \_ pado t -> showPaddedFixedFraction pado (realToFrac t :: Pico)
+    formatCharacter 'Q' = Just $ padGeneral True False 12 '0' $ \_ pado t -> dotNonEmpty $ showPaddedFixedFraction pado (realToFrac t :: Pico) where
+        dotNonEmpty "" = ""
+        dotNonEmpty s = '.':s
+    formatCharacter _   = Nothing
+
+instance FormatTime DiffTime where
+    formatCharacter 'W' = Just $ padNumStd 1 $ quotBy $ 7 * 86400
+    formatCharacter 'D' = Just $ padNumStd 1 $ quotBy 86400
+    formatCharacter 'd' = Just $ padNumStd 1 $ remBy 7 . quotBy 86400
+    formatCharacter 'H' = Just $ padNumStd 1 $ quotBy 3600
+    formatCharacter 'h' = Just $ padNumStd 2 $ remBy 24 . quotBy 3600
+    formatCharacter 'M' = Just $ padNumStd 1 $ quotBy 60
+    formatCharacter 'm' = Just $ padNumStd 2 $ remBy 60 . quotBy 60
+    formatCharacter 'S' = Just $ padNumStd 1 $ quotBy 1
+    formatCharacter 's' = Just $ padNumStd 2 $ remBy 60 . quotBy 1
+    formatCharacter 'q' = Just $ padGeneral True True 12 '0' $ \_ pado t -> showPaddedFixedFraction pado (realToFrac t :: Pico)
+    formatCharacter 'Q' = Just $ padGeneral True False 12 '0' $ \_ pado t -> dotNonEmpty $ showPaddedFixedFraction pado (realToFrac t :: Pico) where
+        dotNonEmpty "" = ""
+        dotNonEmpty s = '.':s
+    formatCharacter _   = Nothing
+
+instance FormatTime CalendarDiffDays where
+    formatCharacter 'Y' = Just $ padNumStd 1 $ quotBy 12 . calendarMonths
+    formatCharacter 'B' = Just $ padNumStd 1 $ calendarMonths
+    formatCharacter 'b' = Just $ padNumStd 1 $ remBy 12 . calendarMonths
+    formatCharacter 'W' = Just $ padNumStd 1 $ quotBy 7 . calendarDays
+    formatCharacter 'D' = Just $ padNumStd 1 $ calendarDays
+    formatCharacter 'd' = Just $ padNumStd 1 $ remBy 7 . calendarDays
+    formatCharacter _   = Nothing
+
+instance FormatTime CalendarDiffTime where
+    formatCharacter 'Y' = Just $ padNumStd 1 $ quotBy 12 . calendarTimeMonths
+    formatCharacter 'B' = Just $ padNumStd 1 $ calendarTimeMonths
+    formatCharacter 'b' = Just $ padNumStd 1 $ remBy 12 . calendarTimeMonths
+    formatCharacter c = fmap (\f fo t -> f fo (calendarTime t)) (formatCharacter c)
index a17f5af..3987603 100644 (file)
@@ -94,9 +94,52 @@ testTimeZone = testGroup "TimeZone"
     testZonePair "E" "-11:30" (-690)
     ]
 
+testAFormat :: FormatTime t => String -> String -> t -> TestTree
+testAFormat fmt expected t = testCase fmt $ assertEqual "" expected $ formatTime defaultTimeLocale fmt t
+
+testNominalDiffTime :: TestTree
+testNominalDiffTime = testGroup "NominalDiffTime"
+    [
+        testAFormat "%Ww%dd%hh%mm%s%Qs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime),
+        testAFormat "%Dd %Hh %Mm %S%Qs" "23d 554h 33262m 1995728.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime),
+        testAFormat "%Ww%dd%hh%mm%s%Qs" "-3w-2d-2h-22m-8.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime),
+        testAFormat "%Dd %Hh %Mm %S%Qs" "-23d -554h -33262m -1995728.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime)
+    ]
+
+testDiffTime :: TestTree
+testDiffTime = testGroup "DiffTime"
+    [
+        testAFormat "%Ww%dd%hh%mm%s%Qs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: DiffTime),
+        testAFormat "%Dd %Hh %Mm %S%Qs" "23d 554h 33262m 1995728.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: DiffTime),
+        testAFormat "%Ww%dd%hh%mm%s%Qs" "-3w-2d-2h-22m-8.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime),
+        testAFormat "%Dd %Hh %Mm %S%Qs" "-23d -554h -33262m -1995728.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime)
+    ]
+
+testCalenderDiffDays :: TestTree
+testCalenderDiffDays = testGroup "CalenderDiffDays"
+    [
+        testAFormat "%Yy%bm%Ww%dd" "5y4m3w2d" $ CalendarDiffDays 64 23,
+        testAFormat "%Bm %Dd" "64m 23d" $ CalendarDiffDays 64 23,
+        testAFormat "%Yy%bm%Ww%dd" "-5y-4m-3w-2d" $ CalendarDiffDays (-64) (-23),
+        testAFormat "%Bm %Dd" "-64m -23d" $ CalendarDiffDays (-64) (-23)
+    ]
+
+testCalenderDiffTime :: TestTree
+testCalenderDiffTime = testGroup "CalenderDiffTime"
+    [
+        testAFormat "%Yy%bm%Ww%dd%hh%mm%s%Qs" "5y4m3w2d2h22m8.21s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21,
+        testAFormat "%Bm %Dd %Hh %Mm %S%Qs" "64m 23d 554h 33262m 1995728.21s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21,
+        testAFormat "%Yy%bm%Ww%dd%hh%mm%s%Qs" "-5y-4m-3w-2d-2h-22m-8.21s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21,
+        testAFormat "%Bm %Dd %Hh %Mm %S%Qs" "-64m -23d -554h -33262m -1995728.21s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21
+    ]
+
 testFormat :: TestTree
 testFormat = testGroup "testFormat" $ [
     testCheckParse,
     testDayOfWeek,
-    testTimeZone
+    testTimeZone,
+    testNominalDiffTime,
+    testDiffTime,
+    testCalenderDiffDays,
+    testCalenderDiffTime
     ]