[commit: packages/time] format-widths,improve-leapseconds,master,posix-perf,tasty,wip/travis: parse single-letter "military" time zones; test parsing of all defaultLocale time zones. Test failure: "EAST" is there twice. (2e0c3f8)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/time

On branches: format-widths,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/2e0c3f84f91a22e6c7cf9ee77d3f823a3aeb9355

>---------------------------------------------------------------

commit 2e0c3f84f91a22e6c7cf9ee77d3f823a3aeb9355
Author: Ashley Yakeley <ashley at yakeley.org>
Date:   Mon Sep 1 20:34:22 2014 -0700

    parse single-letter "military" time zones; test parsing of all defaultLocale time zones. Test failure: "EAST" is there twice.


>---------------------------------------------------------------

2e0c3f84f91a22e6c7cf9ee77d3f823a3aeb9355
 lib/Data/Time/Format/Locale.hs     |  2 --
 lib/Data/Time/Format/Parse.hs      | 16 +++++++++++++++-
 test/ShowDefaultTZAbbreviations.hs |  9 +++++++++
 test/Test/TestParseTime.hs         | 32 ++++++++++++++++++++++++++++++++
 time.cabal                         |  8 ++++++++
 5 files changed, 64 insertions(+), 3 deletions(-)

diff --git a/lib/Data/Time/Format/Locale.hs b/lib/Data/Time/Format/Locale.hs
index 3708b8e..399cb25 100644
--- a/lib/Data/Time/Format/Locale.hs
+++ b/lib/Data/Time/Format/Locale.hs
@@ -210,8 +210,6 @@ _TIMEZONES_ =
     --  Universal Coordinated Time
     ,("UTC",     (readTzOffset "+00:00", False))
     --  Same as UTC
-    ,("Z",       (readTzOffset "+00:00", False))
-    --  Same as UTC
     ,("ZULU",    (readTzOffset "+00:00", False))
     --  Western European Time
     ,("WET",     (readTzOffset "+00:00", False))
diff --git a/lib/Data/Time/Format/Parse.hs b/lib/Data/Time/Format/Parse.hs
index 0064dda..07dc5b2 100644
--- a/lib/Data/Time/Format/Parse.hs
+++ b/lib/Data/Time/Format/Parse.hs
@@ -410,6 +410,18 @@ mkPico i f = fromInteger i + fromRational (f % 1000000000000)
 instance ParseTime LocalTime where
     buildTime l xs = LocalTime (buildTime l xs) (buildTime l xs)
 
+enumDiff :: (Enum a) => a -> a -> Int
+enumDiff a b = (fromEnum a) - (fromEnum b)
+
+getMilZoneHours :: Char -> Maybe Int
+getMilZoneHours c | c < 'A' = Nothing
+getMilZoneHours c | c <= 'I' = Just $ 1 + enumDiff c 'A'
+getMilZoneHours 'J' = Nothing
+getMilZoneHours c | c <= 'M' = Just $ 10 + enumDiff c 'K'
+getMilZoneHours c | c <= 'Y' = Just $ (enumDiff 'N' c) - 1
+getMilZoneHours 'Z' = Just 0
+getMilZoneHours _ = Nothing
+
 instance ParseTime TimeZone where
     buildTime l = foldl f (minutesToTimeZone 0)
       where
@@ -420,7 +432,9 @@ instance ParseTime TimeZone where
                   | isAlpha (head x) -> let y = up x in
                       case find (\tz -> y == timeZoneName tz) (knownTimeZones l) of
                         Just tz -> tz
-                        Nothing -> TimeZone offset dst y
+                        Nothing -> case y of
+                            [yc] | Just hours <- getMilZoneHours yc -> TimeZone (hours * 60) False y
+                            _ -> TimeZone offset dst y
                   | otherwise        -> zone
               _   -> t
           where zone = TimeZone (readTzOffset x) dst name
diff --git a/test/ShowDefaultTZAbbreviations.hs b/test/ShowDefaultTZAbbreviations.hs
new file mode 100644
index 0000000..fc24783
--- /dev/null
+++ b/test/ShowDefaultTZAbbreviations.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import Data.Time
+
+showTZ :: TimeZone -> String
+showTZ tz = (formatTime defaultTimeLocale "%Z %z " tz) ++ show (timeZoneSummerOnly tz)
+
+main :: IO ()
+main = mapM_ (\tz -> putStrLn (showTZ tz)) (knownTimeZones defaultTimeLocale)
diff --git a/test/Test/TestParseTime.hs b/test/Test/TestParseTime.hs
index b0e9ef2..26ee67d 100644
--- a/test/Test/TestParseTime.hs
+++ b/test/Test/TestParseTime.hs
@@ -27,6 +27,9 @@ testParseTime = testGroup "testParseTime"
     simpleFormatTests,
     extests,
     particularParseTests,
+    badParseTests,
+    defaultTimeZoneTests,
+    militaryTimeZoneTests,
     testGroup "properties" (fmap (\(n,prop) -> testProperty n prop) properties)
     ]
 
@@ -156,6 +159,12 @@ particularParseTests = testGroup "particular"
         spacingTests (TimeZone (-480) False "PST") "%Z" "PST"
     ]
 
+badParseTests :: Test
+badParseTests = testGroup "bad"
+    [
+        parseTest False (Nothing :: Maybe Day) "%Y" ""
+    ]
+
 parseYMD :: Day -> Test
 parseYMD day = case toGregorian day of
     (y,m,d) -> parseTest False (Just day) "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d))
@@ -200,6 +209,29 @@ readsTest :: forall t. (Show t, Eq t, ParseTime t) => Maybe t -> String -> Strin
 readsTest (Just e) = readsTest' [(e,"")]
 readsTest Nothing = readsTest' ([] :: [(t,String)])
 -}
+
+enumAdd :: (Enum a) => Int -> a -> a
+enumAdd i a = toEnum (i + fromEnum a)
+
+getMilZoneLetter :: Int -> Char
+getMilZoneLetter 0 = 'Z'
+getMilZoneLetter h | h < 0 = enumAdd (negate h) 'M'
+getMilZoneLetter h | h < 10 = enumAdd (h - 1) 'A'
+getMilZoneLetter h = enumAdd (h - 10) 'K'
+
+getMilZone :: Int -> TimeZone
+getMilZone hour = TimeZone (hour * 60) False [getMilZoneLetter hour]
+
+testParseTimeZone :: TimeZone -> Test
+testParseTimeZone tz = parseTest False (Just tz) "%Z" (timeZoneName tz)
+
+defaultTimeZoneTests :: Test
+defaultTimeZoneTests = testGroup "default time zones" (fmap testParseTimeZone (knownTimeZones defaultTimeLocale))
+
+militaryTimeZoneTests :: Test
+militaryTimeZoneTests = testGroup "military time zones" (fmap (testParseTimeZone . getMilZone) [-12 .. 12])
+
+
 parse :: ParseTime t => Bool -> String -> String -> Maybe t
 parse sp f t = parseTimeM sp defaultTimeLocale f t
 
diff --git a/time.cabal b/time.cabal
index 383267f..b5c1638 100644
--- a/time.cabal
+++ b/time.cabal
@@ -89,6 +89,14 @@ library
             HsTime.h
             HsTimeConfig.h
 
+test-suite ShowDefaultTZAbbreviations
+    hs-source-dirs: test
+    type: exitcode-stdio-1.0
+    build-depends:
+        base,
+        time == 1.5
+    main-is: ShowDefaultTZAbbreviations.hs
+
 test-suite tests
     hs-source-dirs: test
     type: exitcode-stdio-1.0