format everything with hindent
[packages/time.git] / lib / Data / Time / Format / Format / Class.hs
1 module Data.Time.Format.Format.Class
2 (
3 -- * Formatting
4 formatTime
5 , FormatNumericPadding
6 , FormatOptions(..)
7 , FormatTime(..)
8 , ShowPadded
9 , PadOption
10 , formatGeneral
11 , formatString
12 , formatNumber
13 , formatNumberStd
14 , showPaddedFixed
15 , showPaddedFixedFraction
16 , quotBy
17 , remBy
18 ) where
19
20 import Data.Char
21 import Data.Fixed
22 import Data.Maybe
23 import Data.Time.Calendar.Private
24 import Data.Time.Format.Locale
25
26 type FormatNumericPadding = Maybe Char
27
28 data FormatOptions = MkFormatOptions
29 { foLocale :: TimeLocale
30 , foPadding :: Maybe FormatNumericPadding
31 , foWidth :: Maybe Int
32 }
33
34 -- <http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html>
35 class FormatTime t where
36 -- | @since 1.9.1
37 formatCharacter :: Bool -> Char -> Maybe (FormatOptions -> t -> String)
38
39 -- the weird UNIX logic is here
40 getPadOption :: Bool -> Bool -> Int -> Char -> Maybe FormatNumericPadding -> Maybe Int -> PadOption
41 getPadOption trunc fdef idef cdef mnpad mi = let
42 c =
43 case mnpad of
44 Just (Just c') -> c'
45 Just Nothing -> ' '
46 _ -> cdef
47 i =
48 case mi of
49 Just i' ->
50 case mnpad of
51 Just Nothing -> i'
52 _ ->
53 if trunc
54 then i'
55 else max i' idef
56 Nothing -> idef
57 f =
58 case mi of
59 Just _ -> True
60 Nothing ->
61 case mnpad of
62 Nothing -> fdef
63 Just Nothing -> False
64 Just (Just _) -> True
65 in if f
66 then Pad i c
67 else NoPad
68
69 formatGeneral ::
70 Bool -> Bool -> Int -> Char -> (TimeLocale -> PadOption -> t -> String) -> (FormatOptions -> t -> String)
71 formatGeneral trunc fdef idef cdef ff fo =
72 ff (foLocale fo) $ getPadOption trunc fdef idef cdef (foPadding fo) (foWidth fo)
73
74 formatString :: (TimeLocale -> t -> String) -> (FormatOptions -> t -> String)
75 formatString ff = formatGeneral False False 1 ' ' $ \locale pado -> showPadded pado . ff locale
76
77 formatNumber :: (ShowPadded i) => Bool -> Int -> Char -> (t -> i) -> (FormatOptions -> t -> String)
78 formatNumber fdef idef cdef ff = formatGeneral False fdef idef cdef $ \_ pado -> showPaddedNum pado . ff
79
80 formatNumberStd :: Int -> (t -> Integer) -> (FormatOptions -> t -> String)
81 formatNumberStd n = formatNumber False n '0'
82
83 showPaddedFixed :: HasResolution a => PadOption -> PadOption -> Fixed a -> String
84 showPaddedFixed padn padf x
85 | x < 0 = '-' : showPaddedFixed padn padf (negate x)
86 showPaddedFixed padn padf x = let
87 ns = showPaddedNum padn $ (floor x :: Integer)
88 fs = showPaddedFixedFraction padf x
89 ds =
90 if null fs
91 then ""
92 else "."
93 in ns ++ ds ++ fs
94
95 showPaddedFixedFraction :: HasResolution a => PadOption -> Fixed a -> String
96 showPaddedFixedFraction pado x = let
97 digits = dropWhile (== '.') $ dropWhile (/= '.') $ showFixed True x
98 n = length digits
99 in case pado of
100 NoPad -> digits
101 Pad i c ->
102 if i < n
103 then take i digits
104 else digits ++ replicate (i - n) c
105
106 -- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'.
107 --
108 -- The general form is @%\<modifier\>\<width\>\<alternate\>\<specifier\>@, where @\<modifier\>@, @\<width\>@, and @\<alternate\>@ are optional.
109 --
110 -- == @\<modifier\>@
111 -- glibc-style modifiers can be used before the specifier (here marked as @z@):
112 --
113 -- [@%-z@] no padding
114 --
115 -- [@%_z@] pad with spaces
116 --
117 -- [@%0z@] pad with zeros
118 --
119 -- [@%^z@] convert to upper case
120 --
121 -- [@%#z@] convert to lower case (consistently, unlike glibc)
122 --
123 -- == @\<width\>@
124 -- Width digits can also be used after any modifiers and before the specifier (here marked as @z@), for example:
125 --
126 -- [@%4z@] pad to 4 characters (with default padding character)
127 --
128 -- [@%_12z@] pad with spaces to 12 characters
129 --
130 -- == @\<alternate\>@
131 -- An optional @E@ character indicates an alternate formatting. Currently this only affects @%Z@ and @%z@.
132 --
133 -- [@%Ez@] alternate formatting
134 --
135 -- == @\<specifier\>@
136 --
137 -- For all types (note these three are done by 'formatTime', not by 'formatCharacter'):
138 --
139 -- [@%%@] @%@
140 --
141 -- [@%t@] tab
142 --
143 -- [@%n@] newline
144 --
145 -- === 'TimeZone'
146 -- For 'TimeZone' (and 'ZonedTime' and 'UTCTime'):
147 --
148 -- [@%z@] timezone offset in the format @±HHMM@
149 --
150 -- [@%Ez@] timezone offset in the format @±HH:MM@
151 --
152 -- [@%Z@] timezone name (or else offset in the format @±HHMM@)
153 --
154 -- [@%EZ@] timezone name (or else offset in the format @±HH:MM@)
155 --
156 -- === 'LocalTime'
157 -- For 'LocalTime' (and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
158 --
159 -- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@)
160 --
161 -- === 'TimeOfDay'
162 -- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
163 --
164 -- [@%R@] same as @%H:%M@
165 --
166 -- [@%T@] same as @%H:%M:%S@
167 --
168 -- [@%X@] as 'timeFmt' @locale@ (e.g. @%H:%M:%S@)
169 --
170 -- [@%r@] as 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@)
171 --
172 -- [@%P@] day-half of day from ('amPm' @locale@), converted to lowercase, @am@, @pm@
173 --
174 -- [@%p@] day-half of day from ('amPm' @locale@), @AM@, @PM@
175 --
176 -- [@%H@] hour of day (24-hour), 0-padded to two chars, @00@ - @23@
177 --
178 -- [@%k@] hour of day (24-hour), space-padded to two chars, @ 0@ - @23@
179 --
180 -- [@%I@] hour of day-half (12-hour), 0-padded to two chars, @01@ - @12@
181 --
182 -- [@%l@] hour of day-half (12-hour), space-padded to two chars, @ 1@ - @12@
183 --
184 -- [@%M@] minute of hour, 0-padded to two chars, @00@ - @59@
185 --
186 -- [@%S@] second of minute (without decimal part), 0-padded to two chars, @00@ - @60@
187 --
188 -- [@%q@] picosecond of second, 0-padded to twelve chars, @000000000000@ - @999999999999@.
189 --
190 -- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros.
191 -- For a whole number of seconds, @%Q@ omits the decimal point unless padding is specified.
192 --
193 -- === 'UTCTime' and 'ZonedTime'
194 -- For 'UTCTime' and 'ZonedTime':
195 --
196 -- [@%s@] number of whole seconds since the Unix epoch. For times before
197 -- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@
198 -- the decimals are positive, not negative. For example, 0.9 seconds
199 -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@.
200 --
201 -- === 'DayOfWeek'
202 -- For 'DayOfWeek' (and 'Day' and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
203 --
204 -- [@%u@] day of week number for Week Date format, @1@ (= Monday) - @7@ (= Sunday)
205 --
206 -- [@%w@] day of week number, @0@ (= Sunday) - @6@ (= Saturday)
207 --
208 -- [@%a@] day of week, short form ('snd' from 'wDays' @locale@), @Sun@ - @Sat@
209 --
210 -- [@%A@] day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - @Saturday@
211 --
212 -- === 'Day'
213 -- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
214 --
215 -- [@%D@] same as @%m\/%d\/%y@
216 --
217 -- [@%F@] same as @%Y-%m-%d@
218 --
219 -- [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@)
220 --
221 -- [@%Y@] year, no padding. Note @%0Y@ and @%_Y@ pad to four chars
222 --
223 -- [@%y@] year of century, 0-padded to two chars, @00@ - @99@
224 --
225 -- [@%C@] century, no padding. Note @%0C@ and @%_C@ pad to two chars
226 --
227 -- [@%B@] month name, long form ('fst' from 'months' @locale@), @January@ - @December@
228 --
229 -- [@%b@, @%h@] month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@
230 --
231 -- [@%m@] month of year, 0-padded to two chars, @01@ - @12@
232 --
233 -- [@%d@] day of month, 0-padded to two chars, @01@ - @31@
234 --
235 -- [@%e@] day of month, space-padded to two chars, @ 1@ - @31@
236 --
237 -- [@%j@] day of year, 0-padded to three chars, @001@ - @366@
238 --
239 -- [@%f@] century for Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars
240 --
241 -- [@%V@] week of year for Week Date format, 0-padded to two chars, @01@ - @53@
242 --
243 -- [@%U@] week of year where weeks start on Sunday (as 'sundayStartWeek'), 0-padded to two chars, @00@ - @53@
244 --
245 -- [@%W@] week of year where weeks start on Monday (as 'mondayStartWeek'), 0-padded to two chars, @00@ - @53@
246 --
247 -- == Duration types
248 -- The specifiers for 'DiffTime', 'NominalDiffTime', 'CalendarDiffDays', and 'CalendarDiffTime' are semantically
249 -- separate from the other types.
250 -- Specifiers on negative time differences will generally be negative (think 'rem' rather than 'mod').
251 --
252 -- === 'NominalDiffTime' and 'DiffTime'
253 -- Note that a "minute" of 'DiffTime' is simply 60 SI seconds, rather than a minute of civil time.
254 -- Use 'NominalDiffTime' to work with civil time, ignoring any leap seconds.
255 --
256 -- For 'NominalDiffTime' and 'DiffTime':
257 --
258 -- [@%w@] total whole weeks
259 --
260 -- [@%d@] total whole days
261 --
262 -- [@%D@] whole days of week
263 --
264 -- [@%h@] total whole hours
265 --
266 -- [@%H@] whole hours of day
267 --
268 -- [@%m@] total whole minutes
269 --
270 -- [@%M@] whole minutes of hour
271 --
272 -- [@%s@] total whole seconds
273 --
274 -- [@%Es@] total seconds, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros.
275 -- For a whole number of seconds, @%Es@ omits the decimal point unless padding is specified.
276 --
277 -- [@%0Es@] total seconds, with decimal point and \<width\> (default 12) decimal places.
278 --
279 -- [@%S@] whole seconds of minute
280 --
281 -- [@%ES@] seconds of minute, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros.
282 -- For a whole number of seconds, @%ES@ omits the decimal point unless padding is specified.
283 --
284 -- [@%0ES@] seconds of minute as two digits, with decimal point and \<width\> (default 12) decimal places.
285 --
286 -- === 'CalendarDiffDays'
287 -- For 'CalendarDiffDays' (and 'CalendarDiffTime'):
288 --
289 -- [@%y@] total years
290 --
291 -- [@%b@] total months
292 --
293 -- [@%B@] months of year
294 --
295 -- [@%w@] total weeks, not including months
296 --
297 -- [@%d@] total days, not including months
298 --
299 -- [@%D@] days of week
300 --
301 -- === 'CalendarDiffTime'
302 -- For 'CalendarDiffTime':
303 --
304 -- [@%h@] total hours, not including months
305 --
306 -- [@%H@] hours of day
307 --
308 -- [@%m@] total minutes, not including months
309 --
310 -- [@%M@] minutes of hour
311 --
312 -- [@%s@] total whole seconds, not including months
313 --
314 -- [@%Es@] total seconds, not including months, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros.
315 -- For a whole number of seconds, @%Es@ omits the decimal point unless padding is specified.
316 --
317 -- [@%0Es@] total seconds, not including months, with decimal point and \<width\> (default 12) decimal places.
318 --
319 -- [@%S@] whole seconds of minute
320 --
321 -- [@%ES@] seconds of minute, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros.
322 -- For a whole number of seconds, @%ES@ omits the decimal point unless padding is specified.
323 --
324 -- [@%0ES@] seconds of minute as two digits, with decimal point and \<width\> (default 12) decimal places.
325 formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String
326 formatTime _ [] _ = ""
327 formatTime locale ('%':cs) t =
328 case formatTime1 locale cs t of
329 Just result -> result
330 Nothing -> '%' : (formatTime locale cs t)
331 formatTime locale (c:cs) t = c : (formatTime locale cs t)
332
333 formatTime1 :: (FormatTime t) => TimeLocale -> String -> t -> Maybe String
334 formatTime1 locale ('_':cs) t = formatTime2 locale id (Just (Just ' ')) cs t
335 formatTime1 locale ('-':cs) t = formatTime2 locale id (Just Nothing) cs t
336 formatTime1 locale ('0':cs) t = formatTime2 locale id (Just (Just '0')) cs t
337 formatTime1 locale ('^':cs) t = formatTime2 locale (fmap toUpper) Nothing cs t
338 formatTime1 locale ('#':cs) t = formatTime2 locale (fmap toLower) Nothing cs t
339 formatTime1 locale cs t = formatTime2 locale id Nothing cs t
340
341 getDigit :: Char -> Maybe Int
342 getDigit c
343 | c < '0' = Nothing
344 getDigit c
345 | c > '9' = Nothing
346 getDigit c = Just $ (ord c) - (ord '0')
347
348 pullNumber :: Maybe Int -> String -> (Maybe Int, String)
349 pullNumber mx [] = (mx, [])
350 pullNumber mx s@(c:cs) =
351 case getDigit c of
352 Just i -> pullNumber (Just $ (fromMaybe 0 mx) * 10 + i) cs
353 Nothing -> (mx, s)
354
355 formatTime2 ::
356 (FormatTime t) => TimeLocale -> (String -> String) -> Maybe FormatNumericPadding -> String -> t -> Maybe String
357 formatTime2 locale recase mpad cs t = let
358 (mwidth, rest) = pullNumber Nothing cs
359 in formatTime3 locale recase mpad mwidth rest t
360
361 formatTime3 ::
362 (FormatTime t)
363 => TimeLocale
364 -> (String -> String)
365 -> Maybe FormatNumericPadding
366 -> Maybe Int
367 -> String
368 -> t
369 -> Maybe String
370 formatTime3 locale recase mpad mwidth ('E':cs) = formatTime4 True recase (MkFormatOptions locale mpad mwidth) cs
371 formatTime3 locale recase mpad mwidth cs = formatTime4 False recase (MkFormatOptions locale mpad mwidth) cs
372
373 formatTime4 :: (FormatTime t) => Bool -> (String -> String) -> FormatOptions -> String -> t -> Maybe String
374 formatTime4 alt recase fo (c:cs) t = Just $ (recase (formatChar alt c fo t)) ++ (formatTime (foLocale fo) cs t)
375 formatTime4 _alt _recase _fo [] _t = Nothing
376
377 formatChar :: (FormatTime t) => Bool -> Char -> FormatOptions -> t -> String
378 formatChar _ '%' = formatString $ \_ _ -> "%"
379 formatChar _ 't' = formatString $ \_ _ -> "\t"
380 formatChar _ 'n' = formatString $ \_ _ -> "\n"
381 formatChar alt c =
382 case formatCharacter alt c of
383 Just f -> f
384 _ -> \_ _ -> ""