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