From fc49f3e92d7ce4474d16a282784da6686ed8a180 Mon Sep 17 00:00:00 2001
From: Ashley Yakeley <ashley@semantic.org>
Date: Sat, 24 Nov 2012 18:23:58 -0800
Subject: [PATCH] fix format modifiers for YCGf
Ignore-this: 6fb972e177214f11f807e125d5e69da3
darcs-hash:20121125022358-ac6dd-901bbe054d6df17f3410480ba25140d6d0068879
---
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]
--
GitLab