[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: allow - _ 0 modifiers in % parsing (b2902c9)

git at git.haskell.org git at git.haskell.org
Fri Apr 21 16:51:04 UTC 2017 

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

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

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

commit b2902c953cbe901a755539cdde45458d6b623c74
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Sat May 7 22:57:59 2011 -0700

    allow - _ 0 modifiers in % parsing
    
    Ignore-this: 275981732f80ca7fd14bf2a33a578632
    
    darcs-hash:20110508055759-ac6dd-aff88a854a40ff2ad6e168ed5c719bdf55b72d31


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

b2902c953cbe901a755539cdde45458d6b623c74
 Data/Time/Format/Parse.hs | 89 +++++++++++++++++++++++++----------------------
 test/TestFormat.hs        |  3 ++
 2 files changed, 51 insertions(+), 41 deletions(-)

diff --git a/Data/Time/Format/Parse.hs b/Data/Time/Format/Parse.hs
index 135fc01..b8855c1 100644
--- a/Data/Time/Format/Parse.hs
+++ b/Data/Time/Format/Parse.hs
@@ -104,9 +104,12 @@ readsTime l f = readP_to_S (liftM (buildTime l) r)
 -- * Internals
 --
 
+data Padding = NoPadding | SpacePadding | ZeroPadding
+  deriving Show
+
 type DateFormat = [DateFormatSpec]
 
-data DateFormatSpec = Value Char
+data DateFormatSpec = Value (Maybe Padding) Char
                      | WhiteSpace
                      | Literal Char
   deriving Show
@@ -114,31 +117,33 @@ data DateFormatSpec = Value Char
 parseFormat :: TimeLocale -> String -> DateFormat
 parseFormat l = p
   where p "" = []
-        p ('%': c :cs) = s ++ p cs
-            where s = case c of
-                        'c' -> p (dateTimeFmt l)
-                        'R' -> p "%H:%M"
-                        'T' -> p "%H:%M:%S"
-                        'X' -> p (timeFmt l)
-                        'r' -> p (time12Fmt l)
-                        'D' -> p "%m/%d/%y"
-                        'F' -> p "%Y-%m-%d"
-                        'x' -> p (dateFmt l)
-                        'h' -> p "%b"
-                        '%' -> [Literal '%']
-                        _   -> [Value c]
+        p ('%': '-' : c :cs) = (pc (Just NoPadding) c) ++ p cs
+        p ('%': '_' : c :cs) = (pc (Just SpacePadding) c) ++ p cs
+        p ('%': '0' : c :cs) = (pc (Just ZeroPadding) c) ++ p cs
+        p ('%': c :cs) = (pc Nothing c) ++ p cs
         p (c:cs) | isSpace c = WhiteSpace : p cs
         p (c:cs) = Literal c : p cs
+        pc _ 'c' = p (dateTimeFmt l)
+        pc _ 'R' = p "%H:%M"
+        pc _ 'T' = p "%H:%M:%S"
+        pc _ 'X' = p (timeFmt l)
+        pc _ 'r' = p (time12Fmt l)
+        pc _ 'D' = p "%m/%d/%y"
+        pc _ 'F' = p "%Y-%m-%d"
+        pc _ 'x' = p (dateFmt l)
+        pc _ 'h' = p "%b"
+        pc _ '%' = [Literal '%']
+        pc mpad c   = [Value mpad c]
 
 parseInput :: TimeLocale -> DateFormat -> ReadP [(Char,String)]
 parseInput l = liftM catMaybes . mapM p
-  where p (Value c)   = parseValue l c >>= return . Just . (,) c
+  where p (Value mpad c)   = parseValue l mpad c >>= return . Just . (,) c
         p WhiteSpace  = skipSpaces >> return Nothing
         p (Literal c) = char c >> return Nothing
 
 -- | Get the string corresponding to the given format specifier.
-parseValue :: TimeLocale -> Char -> ReadP String
-parseValue l c = 
+parseValue :: TimeLocale -> Maybe Padding -> Char -> ReadP String
+parseValue l mpad c = 
     case c of
       'z' -> numericTZ
       'Z' -> munch1 isAlpha <++
@@ -146,40 +151,42 @@ parseValue l c =
              return "" -- produced by %Z for LocalTime
       'P' -> oneOf (let (am,pm) = amPm l in [am, pm])
       'p' -> oneOf (let (am,pm) = amPm l in [am, pm])
-      'H' -> digits 2
-      'I' -> digits 2
-      'k' -> spdigits 2
-      'l' -> spdigits 2
-      'M' -> digits 2 
-      'S' -> digits 2
-      'q' -> digits 12
+      'H' -> digits ZeroPadding 2
+      'I' -> digits ZeroPadding 2
+      'k' -> digits NoPadding 2
+      'l' -> digits NoPadding 2
+      'M' -> digits ZeroPadding 2 
+      'S' -> digits ZeroPadding 2
+      'q' -> digits ZeroPadding 12
       'Q' -> liftM2 (:) (char '.') (munch isDigit) <++ return ""
       's' -> (char '-' >> liftM ('-':) (munch1 isDigit)) 
              <++ munch1 isDigit
-      'Y' -> digits 4
-      'y' -> digits 2
-      'C' -> digits 2
+      'Y' -> digits ZeroPadding 4
+      'y' -> digits ZeroPadding 2
+      'C' -> digits ZeroPadding 2
       'B' -> oneOf (map fst (months l))
       'b' -> oneOf (map snd (months l))
-      'm' -> digits 2
-      'd' -> digits 2
-      'e' -> spdigits 2
-      'j' -> digits 3
-      'G' -> digits 4
-      'g' -> digits 2
-      'f' -> digits 2
-      'V' -> digits 2
+      'm' -> digits ZeroPadding 2
+      'd' -> digits ZeroPadding 2
+      'e' -> digits NoPadding 2
+      'j' -> digits ZeroPadding 3
+      'G' -> digits ZeroPadding 4
+      'g' -> digits ZeroPadding 2
+      'f' -> digits ZeroPadding 2
+      'V' -> digits ZeroPadding 2
       'u' -> oneOf $ map (:[]) ['1'..'7']
       'a' -> oneOf (map snd (wDays l))
       'A' -> oneOf (map fst (wDays l))
-      'U' -> digits 2
+      'U' -> digits ZeroPadding 2
       'w' -> oneOf $ map (:[]) ['0'..'6']
-      'W' -> digits 2
+      'W' -> digits ZeroPadding 2
       _   -> fail $ "Unknown format character: " ++ show c
   where
     oneOf = choice . map string
-    digits n = count n (satisfy isDigit)
-    spdigits n = skipSpaces >> oneUpTo n (satisfy isDigit)
+    digitsforce ZeroPadding n = count n (satisfy isDigit)
+    digitsforce SpacePadding n = skipSpaces >> oneUpTo n (satisfy isDigit)
+    digitsforce NoPadding n = skipSpaces >> oneUpTo n (satisfy isDigit)
+    digits pad = digitsforce (fromMaybe pad mpad)
     oneUpTo :: Int -> ReadP a -> ReadP [a]
     oneUpTo 0 _ = pfail
     oneUpTo n x = liftM2 (:) x (upTo (n-1) x)
@@ -187,9 +194,9 @@ parseValue l c =
     upTo 0 _ = return []
     upTo n x = (oneUpTo n x) <++ return []
     numericTZ = do s <- choice [char '+', char '-']
-                   h <- digits 2
+                   h <- digitsforce ZeroPadding 2
                    optional (char ':')
-                   m <- digits 2
+                   m <- digitsforce ZeroPadding 2
                    return (s:h++m)
 #endif
 
diff --git a/test/TestFormat.hs b/test/TestFormat.hs
index 65ca575..19173b6 100644
--- a/test/TestFormat.hs
+++ b/test/TestFormat.hs
@@ -131,6 +131,9 @@ compareExpected ts fmt str expected = let
 class (ParseTime t) => TestParse t where
     expectedParse :: String -> String -> Maybe t
     expectedParse "%Z" str | all isSpace str = Just (buildTime defaultTimeLocale [])
+    expectedParse "%_Z" str | all isSpace str = Just (buildTime defaultTimeLocale [])
+    expectedParse "%-Z" str | all isSpace str = Just (buildTime defaultTimeLocale [])
+    expectedParse "%0Z" str | all isSpace str = Just (buildTime defaultTimeLocale [])
     expectedParse _ _ = Nothing
 
 instance TestParse Day

More information about the ghc-commits mailing list