fix "%s" format leap-second test issue (#83)
[packages/time.git] / test / main / Test / Format / ParseTime.hs
1 {-# OPTIONS -fno-warn-orphans #-}
2 module Test.Format.ParseTime(testParseTime,test_parse_format) where
3
4 import Control.Monad
5 import Data.Char
6 import Text.Read
7 import Data.Time
8 import Data.Time.Calendar.OrdinalDate
9 import Data.Time.Calendar.WeekDate
10 import Test.QuickCheck.Property
11 import Test.Tasty
12 import Test.Tasty.HUnit
13 import Test.Tasty.QuickCheck hiding (reason)
14 import Test.TestUtil
15 import Test.Arbitrary()
16
17
18 testParseTime :: TestTree
19 testParseTime = testGroup "testParseTime"
20 [
21 readOtherTypesTest,
22 readTests,
23 simpleFormatTests,
24 extests,
25 particularParseTests,
26 badParseTests,
27 defaultTimeZoneTests,
28 militaryTimeZoneTests,
29 propertyTests
30 ]
31
32 yearDays :: Integer -> [Day]
33 yearDays y = [(fromGregorian y 1 1) .. (fromGregorian y 12 31)]
34
35 makeExhaustiveTest :: String -> [t] -> (t -> TestTree) -> TestTree
36 makeExhaustiveTest name cases f = testGroup name (fmap f cases)
37
38 extests :: TestTree
39 extests = testGroup "exhaustive" ([
40 makeExhaustiveTest "parse %y" [0..99] parseYY,
41 makeExhaustiveTest "parse %-C %y 1900s" [0,1,50,99] (parseCYY 19),
42 makeExhaustiveTest "parse %-C %y 2000s" [0,1,50,99] (parseCYY 20),
43 makeExhaustiveTest "parse %-C %y 1400s" [0,1,50,99] (parseCYY 14),
44 makeExhaustiveTest "parse %C %y 0700s" [0,1,50,99] (parseCYY2 7),
45 makeExhaustiveTest "parse %-C %y 700s" [0,1,50,99] (parseCYY 7),
46 makeExhaustiveTest "parse %-C %y 10000s" [0,1,50,99] (parseCYY 100),
47 makeExhaustiveTest "parse %-C centuries" [20..100] (parseCentury " "),
48 makeExhaustiveTest "parse %-C century X" [1,10,20,100] (parseCentury "X"),
49 makeExhaustiveTest "parse %-C century 2sp" [1,10,20,100] (parseCentury " "),
50 makeExhaustiveTest "parse %-C century 5sp" [1,10,20,100] (parseCentury " ")
51 ] ++
52 (concat $ fmap
53 (\y -> [
54 (makeExhaustiveTest "parse %Y%m%d" (yearDays y) parseYMD),
55 (makeExhaustiveTest "parse %Y %m %d" (yearDays y) parseYearDayD),
56 (makeExhaustiveTest "parse %Y %-m %e" (yearDays y) parseYearDayE)
57 ]) [1,4,20,753,2000,2011,10001]))
58
59 readTest :: (Eq a,Show a,Read a) => [(a,String)] -> String -> TestTree
60 readTest expected target = let
61 found = reads target
62 result = assertEqual "" expected found
63 name = show target
64 in Test.Tasty.HUnit.testCase name result
65
66 readTestsParensSpaces :: forall a. (Eq a,Show a,Read a) => a -> String -> TestTree
67 readTestsParensSpaces expected target = testGroup target
68 [
69 readTest [(expected,"")] $ target,
70 readTest [(expected,"")] $ "("++target++")",
71 readTest [(expected,"")] $ " ("++target++")",
72 readTest [(expected," ")] $ " ( "++target++" ) ",
73 readTest [(expected," ")] $ " (( "++target++" )) ",
74 readTest ([] :: [(a,String)]) $ "("++target,
75 readTest [(expected,")")] $ ""++target++")",
76 readTest [(expected,"")] $ "(("++target++"))",
77 readTest [(expected," ")] $ " ( ( "++target++" ) ) "
78 ] where
79
80 readOtherTypesTest :: TestTree
81 readOtherTypesTest = testGroup "read other types"
82 [
83 readTestsParensSpaces (3 :: Integer) "3",
84 readTestsParensSpaces "a" "\"a\""
85 ]
86
87 readTests :: TestTree
88 readTests = testGroup "read times"
89 [
90 readTestsParensSpaces testDay "1912-07-08",
91 --readTestsParensSpaces testDay "1912-7-8",
92 readTestsParensSpaces testTimeOfDay "08:04:02"
93 --,readTestsParensSpaces testTimeOfDay "8:4:2"
94 ] where
95 testDay = fromGregorian 1912 7 8
96 testTimeOfDay = TimeOfDay 8 4 2
97
98 epoch :: LocalTime
99 epoch = LocalTime (fromGregorian 1970 0 0) midnight
100
101 simpleFormatTests :: TestTree
102 simpleFormatTests = testGroup "simple"
103 [
104 readsTest [(epoch,"")] "" "",
105 readsTest [(epoch," ")] "" " ",
106 readsTest [(epoch,"")] " " " ",
107 readsTest [(epoch,"")] " " " ",
108 readsTest [(epoch,"")] "%k" "0",
109 readsTest [(epoch,"")] "%k" " 0",
110 readsTest [(epoch,"")] "%m" "01",
111 readsTest [(epoch," ")] "%m" "01 ",
112 readsTest [(epoch," ")] " %m" " 01 ",
113 readsTest [(epoch,"")] " %m" " 01",
114 -- https://ghc.haskell.org/trac/ghc/ticket/9150
115 readsTest [(epoch,"")] " %M" " 00",
116 readsTest [(epoch,"")] "%M " "00 ",
117 readsTest [(epoch,"")] "%Q" "",
118 readsTest [(epoch," ")] "%Q" " ",
119 readsTest [(epoch,"X")] "%Q" "X",
120 readsTest [(epoch," X")] "%Q" " X",
121 readsTest [(epoch,"")] "%Q " " ",
122 readsTest [(epoch,"")] "%Q X" " X",
123 readsTest [(epoch,"")] "%QX" "X"
124 ] where
125 readsTest :: (Show a, Eq a, ParseTime a) => [(a,String)] -> String -> String -> TestTree
126 readsTest expected formatStr target = let
127 found = readSTime False defaultTimeLocale formatStr target
128 result = assertEqual "" expected found
129 name = (show formatStr) ++ " of " ++ (show target)
130 in Test.Tasty.HUnit.testCase name result
131
132 spacingTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> TestTree
133 spacingTests expected formatStr target = testGroup "particular"
134 [
135 parseTest False (Just expected) formatStr target,
136 parseTest True (Just expected) formatStr target,
137 parseTest False (Just expected) (formatStr ++ " ") (target ++ " "),
138 parseTest True (Just expected) (formatStr ++ " ") (target ++ " "),
139 parseTest False (Just expected) (" " ++ formatStr) (" " ++ target),
140 parseTest True (Just expected) (" " ++ formatStr) (" " ++ target),
141 parseTest True (Just expected) ("" ++ formatStr) (" " ++ target),
142 parseTest True (Just expected) (" " ++ formatStr) (" " ++ target)
143 ]
144
145 particularParseTests :: TestTree
146 particularParseTests = testGroup "particular"
147 [
148 spacingTests epoch "%Q" "",
149 spacingTests epoch "%Q" ".0",
150 spacingTests epoch "%k" " 0",
151 spacingTests epoch "%M" "00",
152 spacingTests epoch "%m" "01",
153 spacingTests (TimeZone 120 False "") "%z" "+0200",
154 spacingTests (TimeZone 120 False "") "%Z" "+0200",
155 spacingTests (TimeZone (-480) False "PST") "%Z" "PST"
156 ]
157
158 badParseTests :: TestTree
159 badParseTests = testGroup "bad"
160 [
161 parseTest False (Nothing :: Maybe Day) "%Y" ""
162 ]
163
164 parseYMD :: Day -> TestTree
165 parseYMD day = case toGregorian day of
166 (y,m,d) -> parseTest False (Just day) "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d))
167
168 parseYearDayD :: Day -> TestTree
169 parseYearDayD day = case toGregorian day of
170 (y,m,d) -> parseTest False (Just day) "%Y %m %d" ((show y) ++ " " ++ (show2 m) ++ " " ++ (show2 d))
171
172 parseYearDayE :: Day -> TestTree
173 parseYearDayE day = case toGregorian day of
174 (y,m,d) -> parseTest False (Just day) "%Y %-m %e" ((show y) ++ " " ++ (show m) ++ " " ++ (show d))
175
176 -- | 1969 - 2068
177 expectedYear :: Integer -> Integer
178 expectedYear i | i >= 69 = 1900 + i
179 expectedYear i = 2000 + i
180
181 show2 :: (Show n,Integral n) => n -> String
182 show2 i = (show (div i 10)) ++ (show (mod i 10))
183
184 parseYY :: Integer -> TestTree
185 parseYY i = parseTest False (Just (fromGregorian (expectedYear i) 1 1)) "%y" (show2 i)
186
187 parseCYY :: Integer -> Integer -> TestTree
188 parseCYY c i = parseTest False (Just (fromGregorian ((c * 100) + i) 1 1)) "%-C %y" ((show c) ++ " " ++ (show2 i))
189
190 parseCYY2 :: Integer -> Integer -> TestTree
191 parseCYY2 c i = parseTest False (Just (fromGregorian ((c * 100) + i) 1 1)) "%C %y" ((show2 c) ++ " " ++ (show2 i))
192
193 parseCentury :: String -> Integer -> TestTree
194 parseCentury int c = parseTest False (Just (fromGregorian (c * 100) 1 1)) ("%-C" ++ int ++ "%y") ((show c) ++ int ++ "00")
195
196 parseTest :: (Show t, Eq t, ParseTime t) => Bool -> Maybe t -> String -> String -> TestTree
197 parseTest sp expected formatStr target = let
198 found = parse sp formatStr target
199 result = assertEqual "" expected found
200 name = (show formatStr) ++ " of " ++ (show target) ++ (if sp then " allowing spaces" else "")
201 in Test.Tasty.HUnit.testCase name result
202 {-
203 readsTest :: forall t. (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> TestTree
204 readsTest (Just e) = readsTest' [(e,"")]
205 readsTest Nothing = readsTest' ([] :: [(t,String)])
206 -}
207
208 enumAdd :: (Enum a) => Int -> a -> a
209 enumAdd i a = toEnum (i + fromEnum a)
210
211 getMilZoneLetter :: Int -> Char
212 getMilZoneLetter 0 = 'Z'
213 getMilZoneLetter h | h < 0 = enumAdd (negate h) 'M'
214 getMilZoneLetter h | h < 10 = enumAdd (h - 1) 'A'
215 getMilZoneLetter h = enumAdd (h - 10) 'K'
216
217 getMilZone :: Int -> TimeZone
218 getMilZone hour = TimeZone (hour * 60) False [getMilZoneLetter hour]
219
220 testParseTimeZone :: TimeZone -> TestTree
221 testParseTimeZone tz = parseTest False (Just tz) "%Z" (timeZoneName tz)
222
223 defaultTimeZoneTests :: TestTree
224 defaultTimeZoneTests = testGroup "default time zones" (fmap testParseTimeZone (knownTimeZones defaultTimeLocale))
225
226 militaryTimeZoneTests :: TestTree
227 militaryTimeZoneTests = testGroup "military time zones" (fmap (testParseTimeZone . getMilZone) [-12 .. 12])
228
229
230 parse :: ParseTime t => Bool -> String -> String -> Maybe t
231 parse sp f t = parseTimeM sp defaultTimeLocale f t
232
233 format :: (FormatTime t) => String -> t -> String
234 format f t = formatTime defaultTimeLocale f t
235
236 -- missing from the time package
237 instance Eq ZonedTime where
238 ZonedTime t1 tz1 == ZonedTime t2 tz2 = t1 == t2 && tz1 == tz2
239
240 compareResult' :: (Eq a,Show a) => String -> a -> a -> Result
241 compareResult' extra expected found
242 | expected == found = succeeded
243 | otherwise = failed {reason = "expected " ++ (show expected) ++ ", found " ++ (show found) ++ extra}
244
245 compareResult :: (Eq a,Show a) => a -> a -> Result
246 compareResult = compareResult' ""
247
248 compareParse :: forall a. (Eq a,Show a,ParseTime a) => a -> String -> String -> Result
249 compareParse expected fmt text = compareResult' (", parsing " ++ (show text)) (Just expected) (parse False fmt text)
250
251 --
252 -- * tests for debugging failing cases
253 --
254
255 test_parse_format :: (FormatTime t,ParseTime t,Show t) => String -> t -> (String,String,Maybe t)
256 test_parse_format f t = let s = format f t in (show t, s, parse False f s `asTypeOf` Just t)
257
258 --
259 -- * show and read
260 --
261
262 prop_read_show :: (Read a, Show a, Eq a) => a -> Result
263 prop_read_show t = compareResult (Just t) (readMaybe (show t))
264
265 --
266 -- * special show functions
267 --
268
269 prop_parse_showWeekDate :: Day -> Result
270 prop_parse_showWeekDate d = compareParse d "%G-W%V-%u" (showWeekDate d)
271
272 prop_parse_showGregorian :: Day -> Result
273 prop_parse_showGregorian d = compareParse d "%Y-%m-%d" (showGregorian d)
274
275 prop_parse_showOrdinalDate :: Day -> Result
276 prop_parse_showOrdinalDate d = compareParse d "%Y-%j" (showOrdinalDate d)
277
278 --
279 -- * fromMondayStartWeek and fromSundayStartWeek
280 --
281
282 prop_fromMondayStartWeek :: Day -> Result
283 prop_fromMondayStartWeek d =
284 let (w,wd) = mondayStartWeek d
285 (y,_,_) = toGregorian d
286 in compareResult d (fromMondayStartWeek y w wd)
287
288 prop_fromSundayStartWeek :: Day -> Result
289 prop_fromSundayStartWeek d =
290 let (w,wd) = sundayStartWeek d
291 (y,_,_) = toGregorian d
292 in compareResult d (fromSundayStartWeek y w wd)
293
294 --
295 -- * format and parse
296 --
297
298 prop_parse_format :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result
299 prop_parse_format (FormatString f) t = compareParse t f (format f t)
300
301 -- Verify case-insensitivity with upper case.
302 prop_parse_format_upper :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result
303 prop_parse_format_upper (FormatString f) t = compareParse t f (map toUpper $ format f t)
304
305 -- Verify case-insensitivity with lower case.
306 prop_parse_format_lower :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result
307 prop_parse_format_lower (FormatString f) t = compareParse t f (map toLower $ format f t)
308
309 prop_format_parse_format :: (FormatTime t, ParseTime t) => FormatString t -> t -> Result
310 prop_format_parse_format (FormatString f) t = compareResult
311 (Just (format f t))
312 (fmap (format f) (parse False f (format f t) `asTypeOf` Just t))
313
314 --
315 -- * crashes in parse
316 --
317
318 newtype Input = Input String
319
320 instance Show Input where
321 show (Input s) = s
322
323 instance Arbitrary Input where
324 arbitrary = liftM Input $ list cs
325 where cs = elements (['0'..'9'] ++ ['-',' ','/'] ++ ['a'..'z'] ++ ['A' .. 'Z'])
326 list g = sized (\n -> choose (0,n) >>= \l -> replicateM l g)
327 instance CoArbitrary Input where
328 coarbitrary (Input s) = coarbitrary (sum (map ord s))
329
330 prop_no_crash_bad_input :: (Eq t, ParseTime t) => FormatString t -> Input -> Property
331 prop_no_crash_bad_input fs@(FormatString f) (Input s) = property $
332 case parse False f s of
333 Nothing -> True
334 Just t -> t == t `asTypeOf` formatType fs
335
336 --
337 --
338 --
339
340 newtype FormatString a = FormatString String
341
342 formatType :: FormatString t -> t
343 formatType _ = undefined
344
345 instance Show (FormatString a) where
346 show (FormatString f) = show f
347
348 typedTests :: (forall t. (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result) -> [TestTree]
349 typedTests prop = [
350 nameTest "Day" $ tgroup dayFormats prop,
351 nameTest "TimeOfDay" $ tgroup timeOfDayFormats prop,
352 nameTest "LocalTime" $ tgroup localTimeFormats prop,
353 nameTest "TimeZone" $ tgroup timeZoneFormats prop,
354 nameTest "ZonedTime" $ tgroup zonedTimeFormats prop,
355 nameTest "ZonedTime" $ tgroup zonedTimeAlmostFormats $ \fmt t -> (todSec $ localTimeOfDay $ zonedTimeToLocalTime t) < 60 ==> prop fmt t,
356 nameTest "UTCTime" $ tgroup utcTimeAlmostFormats $ \fmt t -> utctDayTime t < 86400 ==> prop fmt t,
357 nameTest "UniversalTime" $ tgroup universalTimeFormats prop,
358 nameTest "CalendarDiffDays" $ tgroup calendarDiffDaysFormats prop,
359 nameTest "CalenderDiffTime" $ tgroup calendarDiffTimeFormats prop,
360 nameTest "DiffTime" $ tgroup diffTimeFormats prop,
361 nameTest "NominalDiffTime" $ tgroup nominalDiffTimeFormats prop
362 ]
363
364 formatParseFormatTests :: TestTree
365 formatParseFormatTests = nameTest "format_parse_format" [
366 nameTest "Day" $ tgroup partialDayFormats prop_format_parse_format,
367 nameTest "TimeOfDay" $ tgroup partialTimeOfDayFormats prop_format_parse_format,
368 nameTest "LocalTime" $ tgroup partialLocalTimeFormats prop_format_parse_format,
369 nameTest "ZonedTime" $ tgroup partialZonedTimeFormats prop_format_parse_format,
370 nameTest "UTCTime" $ tgroup partialUTCTimeFormats prop_format_parse_format,
371 nameTest "UniversalTime" $ tgroup partialUniversalTimeFormats prop_format_parse_format
372 ]
373
374 badInputTests :: TestTree
375 badInputTests = nameTest "no_crash_bad_input" [
376 nameTest "Day" $ tgroup (dayFormats ++ partialDayFormats ++ failingPartialDayFormats) prop_no_crash_bad_input,
377 nameTest "TimeOfDay" $ tgroup (timeOfDayFormats ++ partialTimeOfDayFormats) prop_no_crash_bad_input,
378 nameTest "LocalTime" $ tgroup (localTimeFormats ++ partialLocalTimeFormats) prop_no_crash_bad_input,
379 nameTest "TimeZone" $ tgroup (timeZoneFormats) prop_no_crash_bad_input,
380 nameTest "ZonedTime" $ tgroup (zonedTimeFormats ++ zonedTimeAlmostFormats ++ partialZonedTimeFormats) prop_no_crash_bad_input,
381 nameTest "UTCTime" $ tgroup (utcTimeAlmostFormats ++ partialUTCTimeFormats) prop_no_crash_bad_input,
382 nameTest "UniversalTime" $ tgroup (universalTimeFormats ++ partialUniversalTimeFormats) prop_no_crash_bad_input
383 ]
384
385 readShowTests :: TestTree
386 readShowTests = nameTest "read_show" [
387 nameTest "Day" (prop_read_show :: Day -> Result),
388 nameTest "TimeOfDay" (prop_read_show :: TimeOfDay -> Result),
389 nameTest "LocalTime" (prop_read_show :: LocalTime -> Result),
390 nameTest "TimeZone" (prop_read_show :: TimeZone -> Result),
391 nameTest "ZonedTime" (prop_read_show :: ZonedTime -> Result),
392 nameTest "UTCTime" (prop_read_show :: UTCTime -> Result),
393 nameTest "UniversalTime" (prop_read_show :: UniversalTime -> Result),
394 nameTest "CalendarDiffDays" (prop_read_show :: CalendarDiffDays -> Result),
395 nameTest "CalendarDiffTime" (prop_read_show :: CalendarDiffTime -> Result)
396 ]
397
398 parseShowTests :: TestTree
399 parseShowTests = nameTest "parse_show" [
400 nameTest "showWeekDate" prop_parse_showWeekDate,
401 nameTest "showGregorian" prop_parse_showGregorian,
402 nameTest "showOrdinalDate" prop_parse_showOrdinalDate
403 ]
404
405 propertyTests :: TestTree
406 propertyTests = nameTest "properties" [
407 readShowTests,
408 parseShowTests,
409 nameTest "fromMondayStartWeek" prop_fromMondayStartWeek,
410 nameTest "fromSundayStartWeek" prop_fromSundayStartWeek,
411 nameTest "parse_format" $ typedTests prop_parse_format,
412 nameTest "parse_format_lower" $ typedTests prop_parse_format_lower,
413 nameTest "parse_format_upper" $ typedTests prop_parse_format_upper,
414 formatParseFormatTests,
415 badInputTests
416 ]
417
418 dayFormats :: [FormatString Day]
419 dayFormats = map FormatString
420 [
421 -- numeric year, month, day
422 "%Y-%m-%d","%Y%m%d","%C%y%m%d","%Y %m %e","%m/%d/%Y","%d/%m/%Y","%Y/%d/%m","%D %C","%F",
423 -- month names
424 "%Y-%B-%d","%Y-%b-%d","%Y-%h-%d",
425 -- ordinal dates
426 "%Y-%j",
427 -- ISO week dates
428 "%G-%V-%u","%G-%V-%a","%G-%V-%A","%G-%V-%w", "%A week %V, %G", "day %V, week %A, %G",
429 "%G-W%V-%u",
430 "%f%g-%V-%u","%f%g-%V-%a","%f%g-%V-%A","%f%g-%V-%w", "%A week %V, %f%g", "day %V, week %A, %f%g",
431 "%f%g-W%V-%u",
432 -- monday and sunday week dates
433 "%Y-w%U-%A", "%Y-w%W-%A", "%Y-%A-w%U", "%Y-%A-w%W", "%A week %U, %Y", "%A week %W, %Y"
434 ]
435
436 timeOfDayFormats :: [FormatString TimeOfDay]
437 timeOfDayFormats = map FormatString
438 [
439 -- 24 h formats
440 "%H:%M:%S.%q","%k:%M:%S.%q","%H%M%S.%q","%T.%q","%X.%q","%R:%S.%q",
441 "%H:%M:%S%Q","%k:%M:%S%Q","%H%M%S%Q","%T%Q","%X%Q","%R:%S%Q",
442 -- 12 h formats
443 "%I:%M:%S.%q %p","%I:%M:%S.%q %P","%l:%M:%S.%q %p","%r %q",
444 "%I:%M:%S%Q %p","%I:%M:%S%Q %P","%l:%M:%S%Q %p","%r %Q"
445 ]
446
447 localTimeFormats :: [FormatString LocalTime]
448 localTimeFormats = map FormatString [{-"%Q","%Q ","%QX"-}]
449
450 timeZoneFormats :: [FormatString TimeZone]
451 timeZoneFormats = map FormatString ["%z","%z%Z","%Z%z","%Z"]
452
453 zonedTimeFormats :: [FormatString ZonedTime]
454 zonedTimeFormats = map FormatString
455 ["%a, %d %b %Y %H:%M:%S.%q %z", "%a, %d %b %Y %H:%M:%S%Q %z",
456 "%a, %d %b %Y %H:%M:%S.%q %Z", "%a, %d %b %Y %H:%M:%S%Q %Z"]
457
458 zonedTimeAlmostFormats :: [FormatString ZonedTime]
459 zonedTimeAlmostFormats = map FormatString ["%s.%q %z", "%s%Q %z", "%s.%q %Z", "%s%Q %Z"]
460
461 utcTimeAlmostFormats :: [FormatString UTCTime]
462 utcTimeAlmostFormats = map FormatString ["%s.%q","%s%Q"]
463
464 universalTimeFormats :: [FormatString UniversalTime]
465 universalTimeFormats = map FormatString []
466
467 calendarDiffDaysFormats :: [FormatString CalendarDiffDays]
468 calendarDiffDaysFormats = map FormatString ["%Yy%bm%Ww%dd","%Yy%bm%Dd","%Bm%Ww%dd","%Bm%Dd"]
469
470 calendarDiffTimeFormats :: [FormatString CalendarDiffTime]
471 calendarDiffTimeFormats = map FormatString ["%Yy%bm%Ww%dd%hh%mm%Ess","%Bm%Ww%dd%hh%mm%Ess","%Bm%Dd%hh%mm%Ess","%Bm%Hh%mm%Ess","%Bm%Mm%Ess","%Bm%Mm%0Ess","%Bm%ESs","%Bm%0ESs"]
472
473 diffTimeFormats :: [FormatString DiffTime]
474 diffTimeFormats = map FormatString ["%Ww%dd%hh%mm%Ess","%Dd%hh%mm%Ess","%Hh%mm%Ess","%Mm%Ess","%Mm%0Ess","%ESs","%0ESs"]
475
476 nominalDiffTimeFormats :: [FormatString NominalDiffTime]
477 nominalDiffTimeFormats = map FormatString ["%Ww%dd%hh%mm%Ess","%Dd%hh%mm%Ess","%Hh%mm%Ess","%Mm%Ess","%Mm%0Ess","%ESs","%0ESs"]
478
479 --
480 -- * Formats that do not include all the information
481 --
482
483 partialDayFormats :: [FormatString Day]
484 partialDayFormats = map FormatString
485 [ ]
486
487 partialTimeOfDayFormats :: [FormatString TimeOfDay]
488 partialTimeOfDayFormats = map FormatString
489 [ ]
490
491 partialLocalTimeFormats :: [FormatString LocalTime]
492 partialLocalTimeFormats = map FormatString
493 [ ]
494
495 partialZonedTimeFormats :: [FormatString ZonedTime]
496 partialZonedTimeFormats = map FormatString
497 [
498 -- %s does not include second decimals
499 "%s %z",
500 -- %S does not include second decimals
501 "%c", "%a, %d %b %Y %H:%M:%S %Z"
502 ]
503
504 partialUTCTimeFormats :: [FormatString UTCTime]
505 partialUTCTimeFormats = map FormatString
506 [
507 -- %s does not include second decimals
508 "%s",
509 -- %c does not include second decimals
510 "%c"
511 ]
512
513 partialUniversalTimeFormats :: [FormatString UniversalTime]
514 partialUniversalTimeFormats = map FormatString
515 [ ]
516
517 failingPartialDayFormats :: [FormatString Day]
518 failingPartialDayFormats = map FormatString
519 [ -- ISO week dates with two digit year.
520 -- This can fail in the beginning or the end of a year where
521 -- the ISO week date year does not match the gregorian year.
522 "%g-%V-%u","%g-%V-%a","%g-%V-%A","%g-%V-%w", "%A week %V, %g", "day %V, week %A, %g",
523 "%g-W%V-%u"
524 ]