2106437323e157cd02720e27fd80dc787ef18091
[packages/time.git] / lib / Data / Time / Format / Format / Instances.hs
1 {-# OPTIONS -fno-warn-orphans #-}
2 module Data.Time.Format.Format.Instances () where
3
4 import Data.Char
5 import Data.Fixed
6 import Data.Time.Clock.Internal.DiffTime
7 import Data.Time.Clock.Internal.NominalDiffTime
8 import Data.Time.Clock.Internal.UniversalTime
9 import Data.Time.Clock.Internal.UTCTime
10 import Data.Time.Clock.POSIX
11 import Data.Time.Calendar.Days
12 import Data.Time.Calendar.CalendarDiffDays
13 import Data.Time.Calendar.Gregorian
14 import Data.Time.Calendar.Week
15 import Data.Time.Calendar.WeekDate
16 import Data.Time.Calendar.OrdinalDate
17 import Data.Time.Calendar.Private
18 import Data.Time.LocalTime.Internal.CalendarDiffTime
19 import Data.Time.LocalTime.Internal.TimeZone
20 import Data.Time.LocalTime.Internal.TimeOfDay
21 import Data.Time.LocalTime.Internal.LocalTime
22 import Data.Time.LocalTime.Internal.ZonedTime
23 import Data.Time.Format.Locale
24 import Data.Time.Format.Format.Class
25
26
27 instance FormatTime LocalTime where
28 formatCharacter _ 'c' = Just $ \fo -> formatTime (foLocale fo) $ dateTimeFmt $ foLocale fo
29 formatCharacter alt c = case formatCharacter alt c of
30 Just f -> Just $ \fo dt -> f fo (localDay dt)
31 Nothing -> case formatCharacter alt c of
32 Just f -> Just $ \fo dt -> f fo (localTimeOfDay dt)
33 Nothing -> Nothing
34
35 todAMPM :: TimeLocale -> TimeOfDay -> String
36 todAMPM locale day = let
37 (am,pm) = amPm locale
38 in if (todHour day) < 12 then am else pm
39
40 tod12Hour :: TimeOfDay -> Int
41 tod12Hour day = (mod (todHour day - 1) 12) + 1
42
43 instance FormatTime TimeOfDay where
44 -- Aggregate
45 formatCharacter _ 'R' = Just $ formatString $ \locale -> formatTime locale "%H:%M"
46 formatCharacter _ 'T' = Just $ formatString $ \locale -> formatTime locale "%H:%M:%S"
47 formatCharacter _ 'X' = Just $ formatString $ \locale -> formatTime locale (timeFmt locale)
48 formatCharacter _ 'r' = Just $ formatString $ \locale -> formatTime locale (time12Fmt locale)
49 -- AM/PM
50 formatCharacter _ 'P' = Just $ formatString $ \locale -> map toLower . todAMPM locale
51 formatCharacter _ 'p' = Just $ formatString $ \locale -> todAMPM locale
52 -- Hour
53 formatCharacter _ 'H' = Just $ formatNumber True 2 '0' todHour
54 formatCharacter _ 'I' = Just $ formatNumber True 2 '0' tod12Hour
55 formatCharacter _ 'k' = Just $ formatNumber True 2 ' ' todHour
56 formatCharacter _ 'l' = Just $ formatNumber True 2 ' ' tod12Hour
57 -- Minute
58 formatCharacter _ 'M' = Just $ formatNumber True 2 '0' todMin
59 -- Second
60 formatCharacter _ 'S' = Just $ formatNumber True 2 '0' $ (floor . todSec :: TimeOfDay -> Int)
61 formatCharacter _ 'q' = Just $ formatGeneral True True 12 '0' $ \_ pado -> showPaddedFixedFraction pado . todSec
62 formatCharacter _ 'Q' = Just $ formatGeneral True False 12 '0' $ \_ pado -> dotNonEmpty . showPaddedFixedFraction pado . todSec where
63 dotNonEmpty "" = ""
64 dotNonEmpty s = '.':s
65
66 -- Default
67 formatCharacter _ _ = Nothing
68
69 instance FormatTime ZonedTime where
70 formatCharacter _ 'c' = Just $ formatString $ \locale -> formatTime locale (dateTimeFmt locale)
71 formatCharacter _ 's' = Just $ formatNumber True 1 '0' $ (floor . utcTimeToPOSIXSeconds . zonedTimeToUTC :: ZonedTime -> Integer)
72 formatCharacter alt c = case formatCharacter alt c of
73 Just f -> Just $ \fo dt -> f fo (zonedTimeToLocalTime dt)
74 Nothing -> case formatCharacter alt c of
75 Just f -> Just $ \fo dt -> f fo (zonedTimeZone dt)
76 Nothing -> Nothing
77
78 instance FormatTime TimeZone where
79 formatCharacter False 'z' = Just $ formatGeneral False True 4 '0' $ \_ -> timeZoneOffsetString'' False
80 formatCharacter True 'z' = Just $ formatGeneral False True 5 '0' $ \_ -> timeZoneOffsetString'' True
81 formatCharacter alt 'Z' = Just $ \fo z -> let
82 n = timeZoneName z
83 idef = if alt then 5 else 4
84 in if null n then formatGeneral False True idef '0' (\_ -> timeZoneOffsetString'' alt) fo z else formatString (\_ -> timeZoneName) fo z
85 formatCharacter _ _ = Nothing
86
87 instance FormatTime DayOfWeek where
88 formatCharacter _ 'u' = Just $ formatNumber True 1 '0' $ fromEnum
89 formatCharacter _ 'w' = Just $ formatNumber True 1 '0' $ \wd -> (mod (fromEnum wd) 7)
90 formatCharacter _ 'a' = Just $ formatString $ \locale wd -> snd $ (wDays locale) !! (mod (fromEnum wd) 7)
91 formatCharacter _ 'A' = Just $ formatString $ \locale wd -> fst $ (wDays locale) !! (mod (fromEnum wd) 7)
92 formatCharacter _ _ = Nothing
93
94 instance FormatTime Day where
95 -- Aggregate
96 formatCharacter _ 'D' = Just $ formatString $ \locale -> formatTime locale "%m/%d/%y"
97 formatCharacter _ 'F' = Just $ formatString $ \locale -> formatTime locale "%Y-%m-%d"
98 formatCharacter _ 'x' = Just $ formatString $ \locale -> formatTime locale (dateFmt locale)
99
100 -- Year Count
101 formatCharacter _ 'Y' = Just $ formatNumber False 4 '0' $ fst . toOrdinalDate
102 formatCharacter _ 'y' = Just $ formatNumber True 2 '0' $ mod100 . fst . toOrdinalDate
103 formatCharacter _ 'C' = Just $ formatNumber False 2 '0' $ div100 . fst . toOrdinalDate
104 -- Month of Year
105 formatCharacter _ 'B' = Just $ formatString $ \locale -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian
106 formatCharacter _ 'b' = Just $ formatString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian
107 formatCharacter _ 'h' = Just $ formatString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian
108 formatCharacter _ 'm' = Just $ formatNumber True 2 '0' $ (\(_,m,_) -> m) . toGregorian
109 -- Day of Month
110 formatCharacter _ 'd' = Just $ formatNumber True 2 '0' $ (\(_,_,d) -> d) . toGregorian
111 formatCharacter _ 'e' = Just $ formatNumber True 2 ' ' $ (\(_,_,d) -> d) . toGregorian
112 -- Day of Year
113 formatCharacter _ 'j' = Just $ formatNumber True 3 '0' $ snd . toOrdinalDate
114
115 -- ISO 8601 Week Date
116 formatCharacter _ 'G' = Just $ formatNumber False 4 '0' $ (\(y,_,_) -> y) . toWeekDate
117 formatCharacter _ 'g' = Just $ formatNumber True 2 '0' $ mod100 . (\(y,_,_) -> y) . toWeekDate
118 formatCharacter _ 'f' = Just $ formatNumber False 2 '0' $ div100 . (\(y,_,_) -> y) . toWeekDate
119
120 formatCharacter _ 'V' = Just $ formatNumber True 2 '0' $ (\(_,w,_) -> w) . toWeekDate
121 formatCharacter _ 'u' = Just $ formatNumber True 1 '0' $ (\(_,_,d) -> d) . toWeekDate
122
123 -- Day of week
124 formatCharacter _ 'a' = Just $ formatString $ \locale -> snd . ((wDays locale) !!) . snd . sundayStartWeek
125 formatCharacter _ 'A' = Just $ formatString $ \locale -> fst . ((wDays locale) !!) . snd . sundayStartWeek
126 formatCharacter _ 'U' = Just $ formatNumber True 2 '0' $ fst . sundayStartWeek
127 formatCharacter _ 'w' = Just $ formatNumber True 1 '0' $ snd . sundayStartWeek
128 formatCharacter _ 'W' = Just $ formatNumber True 2 '0' $ fst . mondayStartWeek
129
130 -- Default
131 formatCharacter _ _ = Nothing
132
133 instance FormatTime UTCTime where
134 formatCharacter alt c = fmap (\f fo t -> f fo (utcToZonedTime utc t)) (formatCharacter alt c)
135
136 instance FormatTime UniversalTime where
137 formatCharacter alt c = fmap (\f fo t -> f fo (ut1ToLocalTime 0 t)) (formatCharacter alt c)
138
139 instance FormatTime NominalDiffTime where
140 formatCharacter _ 'w' = Just $ formatNumberStd 1 $ quotBy $ 7 * 86400
141 formatCharacter _ 'd' = Just $ formatNumberStd 1 $ quotBy 86400
142 formatCharacter _ 'D' = Just $ formatNumberStd 1 $ remBy 7 . quotBy 86400
143 formatCharacter _ 'h' = Just $ formatNumberStd 1 $ quotBy 3600
144 formatCharacter _ 'H' = Just $ formatNumberStd 2 $ remBy 24 . quotBy 3600
145 formatCharacter _ 'm' = Just $ formatNumberStd 1 $ quotBy 60
146 formatCharacter _ 'M' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 60
147 formatCharacter False 's' = Just $ formatNumberStd 1 $ quotBy 1
148 formatCharacter True 's' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> showPaddedFixed NoPad padf (realToFrac t :: Pico)
149 formatCharacter False 'S' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 1
150 formatCharacter True 'S' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> let
151 padn = case padf of
152 NoPad -> NoPad
153 Pad _ c -> Pad 2 c
154 in showPaddedFixed padn padf (realToFrac $ remBy 60 t :: Pico)
155 formatCharacter _ _ = Nothing
156
157 instance FormatTime DiffTime where
158 formatCharacter _ 'w' = Just $ formatNumberStd 1 $ quotBy $ 7 * 86400
159 formatCharacter _ 'd' = Just $ formatNumberStd 1 $ quotBy 86400
160 formatCharacter _ 'D' = Just $ formatNumberStd 1 $ remBy 7 . quotBy 86400
161 formatCharacter _ 'h' = Just $ formatNumberStd 1 $ quotBy 3600
162 formatCharacter _ 'H' = Just $ formatNumberStd 2 $ remBy 24 . quotBy 3600
163 formatCharacter _ 'm' = Just $ formatNumberStd 1 $ quotBy 60
164 formatCharacter _ 'M' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 60
165 formatCharacter False 's' = Just $ formatNumberStd 1 $ quotBy 1
166 formatCharacter True 's' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> showPaddedFixed NoPad padf (realToFrac t :: Pico)
167 formatCharacter False 'S' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 1
168 formatCharacter True 'S' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> let
169 padn = case padf of
170 NoPad -> NoPad
171 Pad _ c -> Pad 2 c
172 in showPaddedFixed padn padf (realToFrac $ remBy 60 t :: Pico)
173 formatCharacter _ _ = Nothing
174
175 instance FormatTime CalendarDiffDays where
176 formatCharacter _ 'y' = Just $ formatNumberStd 1 $ quotBy 12 . cdMonths
177 formatCharacter _ 'b' = Just $ formatNumberStd 1 $ cdMonths
178 formatCharacter _ 'B' = Just $ formatNumberStd 2 $ remBy 12 . cdMonths
179 formatCharacter _ 'w' = Just $ formatNumberStd 1 $ quotBy 7 . cdDays
180 formatCharacter _ 'd' = Just $ formatNumberStd 1 $ cdDays
181 formatCharacter _ 'D' = Just $ formatNumberStd 1 $ remBy 7 . cdDays
182 formatCharacter _ _ = Nothing
183
184 instance FormatTime CalendarDiffTime where
185 formatCharacter _ 'y' = Just $ formatNumberStd 1 $ quotBy 12 . ctMonths
186 formatCharacter _ 'b' = Just $ formatNumberStd 1 $ ctMonths
187 formatCharacter _ 'B' = Just $ formatNumberStd 2 $ remBy 12 . ctMonths
188 formatCharacter alt c = fmap (\f fo t -> f fo (ctTime t)) (formatCharacter alt c)