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