[commit: packages/time] master, wip/travis: fix format modifiers for YCGf (fc49f3e)

[git at git.haskell.org]

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

On branches: master,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/fc49f3e92d7ce4474d16a282784da6686ed8a180

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

commit fc49f3e92d7ce4474d16a282784da6686ed8a180
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Sat Nov 24 18:23:58 2012 -0800

    fix format modifiers for YCGf
    
    Ignore-this: 6fb972e177214f11f807e125d5e69da3
    
    darcs-hash:20121125022358-ac6dd-901bbe054d6df17f3410480ba25140d6d0068879


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

fc49f3e92d7ce4474d16a282784da6686ed8a180
 Data/Time/Calendar/Private.hs | 32 ++++++++++++++------------------
 Data/Time/Format.hs           |  8 ++++----
 Test/TestFormat.hs            | 21 +++++++++++++++++++--
 3 files changed, 37 insertions(+), 24 deletions(-)

diff --git a/Data/Time/Calendar/Private.hs b/Data/Time/Calendar/Private.hs
index 6afe648..f241dc3 100644
--- a/Data/Time/Calendar/Private.hs
+++ b/Data/Time/Calendar/Private.hs
@@ -9,33 +9,29 @@ pad1 :: NumericPadOption -> String -> String
 pad1 (Just c) s = c:s
 pad1 _ s = s
 
+padN :: Int -> Char -> String -> String
+padN i _ s | i <= 0 = s
+padN i c s = (replicate i c) ++ s
+
 show2Fixed :: NumericPadOption -> Pico -> String
 show2Fixed opt x | x < 10 = pad1 opt (showFixed True x)
 show2Fixed _ x = showFixed True x
 
+showPaddedMin :: (Num t,Ord t,Show t) => Int -> NumericPadOption -> t -> String
+showPaddedMin _ Nothing i = show i
+showPaddedMin pl opt i | i < 0 = '-':(showPaddedMin pl opt (negate i))
+showPaddedMin pl (Just c) i =
+  let s = show i in 
+    padN (pl - (length s)) c s
+
 show2 :: (Num t,Ord t,Show t) => NumericPadOption -> t -> String
-show2 opt i | i < 0 = '-':(show2 opt (negate i))
-show2 opt i = let
-	s = show i in
-  case s of
-	[_] -> pad1 opt s
-	_ -> s
+show2 = showPaddedMin 2
 
 show3 :: (Num t,Ord t,Show t) => NumericPadOption -> t -> String
-show3 opt i | i < 0 = '-':(show3 opt (negate i))
-show3 opt i = let
-	s = show2 opt i in
-  case s of
-	[_,_] -> pad1 opt s
-	_ -> s
+show3 = showPaddedMin 3
 
 show4 :: (Num t,Ord t,Show t) => NumericPadOption -> t -> String
-show4 opt i | i < 0 = '-':(show4 opt (negate i))
-show4 opt i = let
-	s = show3 opt i in
-  case s of
-	[_,_,_] -> pad1 opt s
-	_ -> s
+show4 = showPaddedMin 4
 
 mod100 :: (Integral i) => i -> i
 mod100 x = mod x 100
diff --git a/Data/Time/Format.hs b/Data/Time/Format.hs
index 926004b..f332f97 100644
--- a/Data/Time/Format.hs
+++ b/Data/Time/Format.hs
@@ -211,9 +211,9 @@ instance FormatTime Day where
 	formatCharacter 'x' = Just (\locale _ -> formatTime locale (dateFmt locale))
 
 	-- Year Count
-	formatCharacter 'Y' = Just (\_ _ -> show . fst . toOrdinalDate)
+	formatCharacter 'Y' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . fst . toOrdinalDate)
 	formatCharacter 'y' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . fst . toOrdinalDate)
-	formatCharacter 'C' = Just (\_ _ -> show . div100 . fst . toOrdinalDate)
+	formatCharacter 'C' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . fst . toOrdinalDate)
 	-- Month of Year
 	formatCharacter 'B' = Just (\locale _ -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)
 	formatCharacter 'b' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)
@@ -226,9 +226,9 @@ instance FormatTime Day where
 	formatCharacter 'j' = Just (\_ opt -> (show3 (fromMaybe (Just '0') opt)) . snd . toOrdinalDate)
 
 	-- ISO 8601 Week Date
-	formatCharacter 'G' = Just (\_ _ -> show . (\(y,_,_) -> y) . toWeekDate)
+	formatCharacter 'G' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . (\(y,_,_) -> y) . toWeekDate)
 	formatCharacter 'g' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . (\(y,_,_) -> y) . toWeekDate)
-	formatCharacter 'f' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . div100 . (\(y,_,_) -> y) . toWeekDate)
+	formatCharacter 'f' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . (\(y,_,_) -> y) . toWeekDate)
 
 	formatCharacter 'V' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,w,_) -> w) . toWeekDate)
 	formatCharacter 'u' = Just (\_ _ -> show . (\(_,_,d) -> d) . toWeekDate)
diff --git a/Test/TestFormat.hs b/Test/TestFormat.hs
index c063847..fe5f375 100644
--- a/Test/TestFormat.hs
+++ b/Test/TestFormat.hs
@@ -70,17 +70,34 @@ times :: [UTCTime]
 times = [baseTime0] ++ (fmap getDay [0..23]) ++ (fmap getDay [0..100]) ++
 	(fmap getYearP1 years) ++ (fmap getYearP2 years) ++ (fmap getYearP3 years) ++ (fmap getYearP4 years)
 
+padN :: Int -> Char -> String -> String
+padN n _ s | n <= (length s) = s
+padN n c s = (replicate (n - length s) c) ++ s
+
+unixWorkarounds :: String -> String -> String
+unixWorkarounds "%_Y" s = padN 4 ' ' s
+unixWorkarounds "%0Y" s = padN 4 '0' s
+unixWorkarounds "%_C" s = padN 2 ' ' s
+unixWorkarounds "%0C" s = padN 2 '0' s
+unixWorkarounds "%_G" s = padN 4 ' ' s
+unixWorkarounds "%0G" s = padN 4 '0' s
+unixWorkarounds "%_f" s = padN 2 ' ' s
+unixWorkarounds "%0f" s = padN 2 '0' s
+unixWorkarounds _ s = s
+
 compareFormat :: String -> (String -> String) -> String -> TimeZone -> UTCTime -> Test
 compareFormat testname modUnix fmt zone time = let
     ctime = utcToZonedTime zone time 
     haskellText = formatTime locale fmt ctime
     in ioTest (testname ++ ": " ++ (show fmt) ++ " of " ++ (show ctime)) $
     do
-       unixText <- fmap modUnix (unixFormatTime fmt zone time)
-       return $ diff unixText haskellText
+       unixText <- unixFormatTime fmt zone time
+       let expectedText = unixWorkarounds fmt (modUnix unixText)
+       return $ diff expectedText haskellText
 
 -- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
 -- plus FgGklz
+-- f not supported
 -- P not always supported
 -- s time-zone dependent
 chars :: [Char]