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