Format: update comment on %Q specifier
[packages/time.git] / lib / Data / Time / Format.hs
1 module Data.Time.Format
2 (
3 -- * UNIX-style formatting
4 NumericPadOption,FormatTime(..),formatTime,
5 module Data.Time.Format.Parse
6 ) where
7
8 import Data.Maybe
9 import Data.Char
10 import Data.Fixed
11
12 import Data.Time.Clock.Internal.UniversalTime
13 import Data.Time.Clock.Internal.UTCTime
14 import Data.Time.Clock.POSIX
15 import Data.Time.Calendar.Days
16 import Data.Time.Calendar.Gregorian
17 import Data.Time.Calendar.WeekDate
18 import Data.Time.Calendar.OrdinalDate
19 import Data.Time.Calendar.Private
20 import Data.Time.LocalTime.Internal.TimeZone
21 import Data.Time.LocalTime.Internal.TimeOfDay
22 import Data.Time.LocalTime.Internal.LocalTime
23 import Data.Time.LocalTime.Internal.ZonedTime
24 import Data.Time.Format.Parse
25
26
27 type NumericPadOption = Maybe Char
28
29 -- the weird UNIX logic is here
30 getPadOption :: Bool -> Bool -> Int -> Char -> Maybe NumericPadOption -> Maybe Int -> PadOption
31 getPadOption trunc fdef idef cdef mnpad mi = let
32 c = case mnpad of
33 Just (Just c') -> c'
34 Just Nothing -> ' '
35 _ -> cdef
36 i = case mi of
37 Just i' -> case mnpad of
38 Just Nothing -> i'
39 _ -> if trunc then i' else max i' idef
40 Nothing -> idef
41 f = case mi of
42 Just _ -> True
43 Nothing -> case mnpad of
44 Nothing -> fdef
45 Just Nothing -> False
46 Just (Just _) -> True
47 in if f then Pad i c else NoPad
48
49 padGeneral :: Bool -> Bool -> Int -> Char -> (TimeLocale -> PadOption -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
50 padGeneral trunc fdef idef cdef ff locale mnpad mi = ff locale $ getPadOption trunc fdef idef cdef mnpad mi
51
52 padString :: (TimeLocale -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
53 padString ff = padGeneral False False 1 ' ' $ \locale pado -> showPadded pado . ff locale
54
55 padNum :: (Show i,Ord i,Num i) => Bool -> Int -> Char -> (t -> i) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
56 padNum fdef idef cdef ff = padGeneral False fdef idef cdef $ \_ pado -> showPaddedNum pado . ff
57
58 -- <http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html>
59 class FormatTime t where
60 formatCharacter :: Char -> Maybe (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
61
62 formatChar :: (FormatTime t) => Char -> TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String
63 formatChar '%' = padString $ \_ _ -> "%"
64 formatChar 't' = padString $ \_ _ -> "\t"
65 formatChar 'n' = padString $ \_ _ -> "\n"
66 formatChar c = case formatCharacter c of
67 Just f -> f
68 _ -> \_ _ _ _ -> ""
69
70 -- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'.
71 --
72 -- The general form is @%\<modifier\>\<width\>\<specifier\>@, where @\<modifier\>@ and @\<width\>@ are optional.
73 --
74 -- == @\<modifier\>@
75 -- glibc-style modifiers can be used before the specifier (here marked as @z@):
76 --
77 -- [@%-z@] no padding
78 --
79 -- [@%_z@] pad with spaces
80 --
81 -- [@%0z@] pad with zeros
82 --
83 -- [@%^z@] convert to upper case
84 --
85 -- [@%#z@] convert to lower case (consistently, unlike glibc)
86 --
87 -- == @\<width\>@
88 -- Width digits can also be used after any modifiers and before the specifier (here marked as @z@), for example:
89 --
90 -- [@%4z@] pad to 4 characters (with default padding character)
91 --
92 -- [@%_12z@] pad with spaces to 12 characters
93 --
94 -- == @\<specifier\>@
95 --
96 -- For all types (note these three are done by 'formatTime', not by 'formatCharacter'):
97 --
98 -- [@%%@] @%@
99 --
100 -- [@%t@] tab
101 --
102 -- [@%n@] newline
103 --
104 -- === 'TimeZone'
105 -- For 'TimeZone' (and 'ZonedTime' and 'UTCTime'):
106 --
107 -- [@%z@] timezone offset in the format @-HHMM@.
108 --
109 -- [@%Z@] timezone name
110 --
111 -- === 'LocalTime'
112 -- For 'LocalTime' (and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
113 --
114 -- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@)
115 --
116 -- === 'TimeOfDay'
117 -- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
118 --
119 -- [@%R@] same as @%H:%M@
120 --
121 -- [@%T@] same as @%H:%M:%S@
122 --
123 -- [@%X@] as 'timeFmt' @locale@ (e.g. @%H:%M:%S@)
124 --
125 -- [@%r@] as 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@)
126 --
127 -- [@%P@] day-half of day from ('amPm' @locale@), converted to lowercase, @am@, @pm@
128 --
129 -- [@%p@] day-half of day from ('amPm' @locale@), @AM@, @PM@
130 --
131 -- [@%H@] hour of day (24-hour), 0-padded to two chars, @00@ - @23@
132 --
133 -- [@%k@] hour of day (24-hour), space-padded to two chars, @ 0@ - @23@
134 --
135 -- [@%I@] hour of day-half (12-hour), 0-padded to two chars, @01@ - @12@
136 --
137 -- [@%l@] hour of day-half (12-hour), space-padded to two chars, @ 1@ - @12@
138 --
139 -- [@%M@] minute of hour, 0-padded to two chars, @00@ - @59@
140 --
141 -- [@%S@] second of minute (without decimal part), 0-padded to two chars, @00@ - @60@
142 --
143 -- [@%q@] picosecond of second, 0-padded to twelve chars, @000000000000@ - @999999999999@.
144 --
145 -- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros.
146 -- For a whole number of seconds, @%Q@ omits the decimal point unless padding is specified.
147 --
148 -- === 'UTCTime' and 'ZonedTime'
149 -- For 'UTCTime' and 'ZonedTime':
150 --
151 -- [@%s@] number of whole seconds since the Unix epoch. For times before
152 -- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@
153 -- the decimals are positive, not negative. For example, 0.9 seconds
154 -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@.
155 --
156 -- === 'Day'
157 -- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
158 --
159 -- [@%D@] same as @%m\/%d\/%y@
160 --
161 -- [@%F@] same as @%Y-%m-%d@
162 --
163 -- [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@)
164 --
165 -- [@%Y@] year, no padding. Note @%0Y@ and @%_Y@ pad to four chars
166 --
167 -- [@%y@] year of century, 0-padded to two chars, @00@ - @99@
168 --
169 -- [@%C@] century, no padding. Note @%0C@ and @%_C@ pad to two chars
170 --
171 -- [@%B@] month name, long form ('fst' from 'months' @locale@), @January@ - @December@
172 --
173 -- [@%b@, @%h@] month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@
174 --
175 -- [@%m@] month of year, 0-padded to two chars, @01@ - @12@
176 --
177 -- [@%d@] day of month, 0-padded to two chars, @01@ - @31@
178 --
179 -- [@%e@] day of month, space-padded to two chars, @ 1@ - @31@
180 --
181 -- [@%j@] day of year, 0-padded to three chars, @001@ - @366@
182 --
183 -- [@%f@] century for Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars
184 --
185 -- [@%V@] week of year for Week Date format, 0-padded to two chars, @01@ - @53@
186 --
187 -- [@%u@] day of week for Week Date format, @1@ - @7@
188 --
189 -- [@%a@] day of week, short form ('snd' from 'wDays' @locale@), @Sun@ - @Sat@
190 --
191 -- [@%A@] day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - @Saturday@
192 --
193 -- [@%U@] week of year where weeks start on Sunday (as 'sundayStartWeek'), 0-padded to two chars, @00@ - @53@
194 --
195 -- [@%w@] day of week number, @0@ (= Sunday) - @6@ (= Saturday)
196 --
197 -- [@%W@] week of year where weeks start on Monday (as 'mondayStartWeek'), 0-padded to two chars, @00@ - @53@
198 formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String
199 formatTime _ [] _ = ""
200 formatTime locale ('%':cs) t = case formatTime1 locale cs t of
201 Just result -> result
202 Nothing -> '%':(formatTime locale cs t)
203 formatTime locale (c:cs) t = c:(formatTime locale cs t)
204
205 formatTime1 :: (FormatTime t) => TimeLocale -> String -> t -> Maybe String
206 formatTime1 locale ('_':cs) t = formatTime2 locale id (Just (Just ' ')) cs t
207 formatTime1 locale ('-':cs) t = formatTime2 locale id (Just Nothing) cs t
208 formatTime1 locale ('0':cs) t = formatTime2 locale id (Just (Just '0')) cs t
209 formatTime1 locale ('^':cs) t = formatTime2 locale (fmap toUpper) Nothing cs t
210 formatTime1 locale ('#':cs) t = formatTime2 locale (fmap toLower) Nothing cs t
211 formatTime1 locale cs t = formatTime2 locale id Nothing cs t
212
213 getDigit :: Char -> Maybe Int
214 getDigit c | c < '0' = Nothing
215 getDigit c | c > '9' = Nothing
216 getDigit c = Just $ (ord c) - (ord '0')
217
218 pullNumber :: Maybe Int -> String -> (Maybe Int,String)
219 pullNumber mx [] = (mx,[])
220 pullNumber mx s@(c:cs) = case getDigit c of
221 Just i -> pullNumber (Just $ (fromMaybe 0 mx)*10+i) cs
222 Nothing -> (mx,s)
223
224 formatTime2 :: (FormatTime t) => TimeLocale -> (String -> String) -> Maybe NumericPadOption -> String -> t -> Maybe String
225 formatTime2 locale recase mpad cs t = let
226 (mwidth,rest) = pullNumber Nothing cs
227 in formatTime3 locale recase mpad mwidth rest t
228
229 formatTime3 :: (FormatTime t) => TimeLocale -> (String -> String) -> Maybe NumericPadOption -> Maybe Int -> String -> t -> Maybe String
230 formatTime3 locale recase mpad mwidth (c:cs) t = Just $ (recase (formatChar c locale mpad mwidth t)) ++ (formatTime locale cs t)
231 formatTime3 _locale _recase _mpad _mwidth [] _t = Nothing
232
233 instance FormatTime LocalTime where
234 formatCharacter 'c' = Just $ \locale _ _ -> formatTime locale (dateTimeFmt locale)
235 formatCharacter c = case formatCharacter c of
236 Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (localDay dt)
237 Nothing -> case formatCharacter c of
238 Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (localTimeOfDay dt)
239 Nothing -> Nothing
240
241 todAMPM :: TimeLocale -> TimeOfDay -> String
242 todAMPM locale day = let
243 (am,pm) = amPm locale
244 in if (todHour day) < 12 then am else pm
245
246 tod12Hour :: TimeOfDay -> Int
247 tod12Hour day = (mod (todHour day - 1) 12) + 1
248
249 showPaddedFixedFraction :: HasResolution a => PadOption -> Fixed a -> String
250 showPaddedFixedFraction pado x = let
251 digits = dropWhile (=='.') $ dropWhile (/='.') $ showFixed True x
252 n = length digits
253 in case pado of
254 NoPad -> digits
255 Pad i c -> if i < n
256 then take i digits
257 else digits ++ replicate (i - n) c
258
259 instance FormatTime TimeOfDay where
260 -- Aggregate
261 formatCharacter 'R' = Just $ padString $ \locale -> formatTime locale "%H:%M"
262 formatCharacter 'T' = Just $ padString $ \locale -> formatTime locale "%H:%M:%S"
263 formatCharacter 'X' = Just $ padString $ \locale -> formatTime locale (timeFmt locale)
264 formatCharacter 'r' = Just $ padString $ \locale -> formatTime locale (time12Fmt locale)
265 -- AM/PM
266 formatCharacter 'P' = Just $ padString $ \locale -> map toLower . todAMPM locale
267 formatCharacter 'p' = Just $ padString $ \locale -> todAMPM locale
268 -- Hour
269 formatCharacter 'H' = Just $ padNum True 2 '0' todHour
270 formatCharacter 'I' = Just $ padNum True 2 '0' tod12Hour
271 formatCharacter 'k' = Just $ padNum True 2 ' ' todHour
272 formatCharacter 'l' = Just $ padNum True 2 ' ' tod12Hour
273 -- Minute
274 formatCharacter 'M' = Just $ padNum True 2 '0' todMin
275 -- Second
276 formatCharacter 'S' = Just $ padNum True 2 '0' $ (floor . todSec :: TimeOfDay -> Int)
277 formatCharacter 'q' = Just $ padGeneral True True 12 '0' $ \_ pado -> showPaddedFixedFraction pado . todSec
278 formatCharacter 'Q' = Just $ padGeneral True False 12 '0' $ \_ pado -> dotNonEmpty . showPaddedFixedFraction pado . todSec where
279 dotNonEmpty "" = ""
280 dotNonEmpty s = '.':s
281
282 -- Default
283 formatCharacter _ = Nothing
284
285 instance FormatTime ZonedTime where
286 formatCharacter 'c' = Just $ padString $ \locale -> formatTime locale (dateTimeFmt locale)
287 formatCharacter 's' = Just $ padNum True 1 '0' $ (floor . utcTimeToPOSIXSeconds . zonedTimeToUTC :: ZonedTime -> Integer)
288 formatCharacter c = case formatCharacter c of
289 Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (zonedTimeToLocalTime dt)
290 Nothing -> case formatCharacter c of
291 Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (zonedTimeZone dt)
292 Nothing -> Nothing
293
294 instance FormatTime TimeZone where
295 formatCharacter 'z' = Just $ padGeneral False True 4 '0' $ \_ pado -> showPadded pado . timeZoneOffsetString'' pado
296 formatCharacter 'Z' = Just $ \locale mnpo mi z -> let
297 n = timeZoneName z
298 in if null n then timeZoneOffsetString'' (getPadOption False True 4 '0' mnpo mi) z else padString (\_ -> timeZoneName) locale mnpo mi z
299 formatCharacter _ = Nothing
300
301 instance FormatTime Day where
302 -- Aggregate
303 formatCharacter 'D' = Just $ padString $ \locale -> formatTime locale "%m/%d/%y"
304 formatCharacter 'F' = Just $ padString $ \locale -> formatTime locale "%Y-%m-%d"
305 formatCharacter 'x' = Just $ padString $ \locale -> formatTime locale (dateFmt locale)
306
307 -- Year Count
308 formatCharacter 'Y' = Just $ padNum False 4 '0' $ fst . toOrdinalDate
309 formatCharacter 'y' = Just $ padNum True 2 '0' $ mod100 . fst . toOrdinalDate
310 formatCharacter 'C' = Just $ padNum False 2 '0' $ div100 . fst . toOrdinalDate
311 -- Month of Year
312 formatCharacter 'B' = Just $ padString $ \locale -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian
313 formatCharacter 'b' = Just $ padString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian
314 formatCharacter 'h' = Just $ padString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian
315 formatCharacter 'm' = Just $ padNum True 2 '0' $ (\(_,m,_) -> m) . toGregorian
316 -- Day of Month
317 formatCharacter 'd' = Just $ padNum True 2 '0' $ (\(_,_,d) -> d) . toGregorian
318 formatCharacter 'e' = Just $ padNum True 2 ' ' $ (\(_,_,d) -> d) . toGregorian
319 -- Day of Year
320 formatCharacter 'j' = Just $ padNum True 3 '0' $ snd . toOrdinalDate
321
322 -- ISO 8601 Week Date
323 formatCharacter 'G' = Just $ padNum False 4 '0' $ (\(y,_,_) -> y) . toWeekDate
324 formatCharacter 'g' = Just $ padNum True 2 '0' $ mod100 . (\(y,_,_) -> y) . toWeekDate
325 formatCharacter 'f' = Just $ padNum False 2 '0' $ div100 . (\(y,_,_) -> y) . toWeekDate
326
327 formatCharacter 'V' = Just $ padNum True 2 '0' $ (\(_,w,_) -> w) . toWeekDate
328 formatCharacter 'u' = Just $ padNum True 1 '0' $ (\(_,_,d) -> d) . toWeekDate
329
330 -- Day of week
331 formatCharacter 'a' = Just $ padString $ \locale -> snd . ((wDays locale) !!) . snd . sundayStartWeek
332 formatCharacter 'A' = Just $ padString $ \locale -> fst . ((wDays locale) !!) . snd . sundayStartWeek
333 formatCharacter 'U' = Just $ padNum True 2 '0' $ fst . sundayStartWeek
334 formatCharacter 'w' = Just $ padNum True 1 '0' $ snd . sundayStartWeek
335 formatCharacter 'W' = Just $ padNum True 2 '0' $ fst . mondayStartWeek
336
337 -- Default
338 formatCharacter _ = Nothing
339
340 instance FormatTime UTCTime where
341 formatCharacter c = fmap (\f locale mpado mwidth t -> f locale mpado mwidth (utcToZonedTime utc t)) (formatCharacter c)
342
343 instance FormatTime UniversalTime where
344 formatCharacter c = fmap (\f locale mpado mwidth t -> f locale mpado mwidth (ut1ToLocalTime 0 t)) (formatCharacter c)