format widths: fix %q and %Q specifiers, with tests format-widths
authorAshley Yakeley <ashley@yakeley.org>
Wed, 8 Feb 2017 06:28:33 +0000 (22:28 -0800)
committerAshley Yakeley <ashley@yakeley.org>
Wed, 8 Feb 2017 06:28:33 +0000 (22:28 -0800)
lib/Data/Time/Calendar/Private.hs
lib/Data/Time/Format.hs
test/unix/Test/Format/Format.hs

index c10153b..0a443de 100644 (file)
@@ -14,10 +14,6 @@ showPaddedNum NoPad i = show i
 showPaddedNum pad i | i < 0 = '-':(showPaddedNum pad (negate i))
 showPaddedNum pad i = showPadded pad $ show i
 
-showPaddedFixed :: HasResolution a => PadOption -> Fixed a -> String
-showPaddedFixed NoPad x = showFixed True x
-showPaddedFixed (Pad _ _) x = showFixed False x
-
 show2Fixed :: Pico -> String
 show2Fixed x | x < 10 = '0':(showFixed True x)
 show2Fixed x = showFixed True x
index 1538d34..d57e4dd 100644 (file)
@@ -7,6 +7,7 @@ module Data.Time.Format
 
 import Data.Maybe
 import Data.Char
+import Data.Fixed
 
 import Data.Time.Clock.Internal.UniversalTime
 import Data.Time.Clock.Internal.UTCTime
@@ -26,8 +27,8 @@ import Data.Time.Format.Parse
 type NumericPadOption = Maybe Char
 
 -- the weird UNIX logic is here
-getPadOption :: Bool -> Int -> Char -> Maybe NumericPadOption -> Maybe Int -> PadOption
-getPadOption fdef idef cdef mnpad mi = let
+getPadOption :: Bool -> Bool -> Int -> Char -> Maybe NumericPadOption -> Maybe Int -> PadOption
+getPadOption trunc fdef idef cdef mnpad mi = let
     c = case mnpad of
         Just (Just c') -> c'
         Just Nothing -> ' '
@@ -35,7 +36,7 @@ getPadOption fdef idef cdef mnpad mi = let
     i = case mi of
         Just i' -> case mnpad of
             Just Nothing -> i'
-            _ -> max i' idef
+            _ -> if trunc then i' else max i' idef
         Nothing -> idef
     f = case mi of
         Just _ -> True
@@ -45,14 +46,14 @@ getPadOption fdef idef cdef mnpad mi = let
             Just (Just _) -> True
     in if f then Pad i c else NoPad
 
-padGeneral :: Bool -> Int -> Char -> (TimeLocale -> PadOption -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
-padGeneral fdef idef cdef ff locale mnpad mi = ff locale $ getPadOption fdef idef cdef mnpad mi
+padGeneral :: Bool -> Bool -> Int -> Char -> (TimeLocale -> PadOption -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
+padGeneral trunc fdef idef cdef ff locale mnpad mi = ff locale $ getPadOption trunc fdef idef cdef mnpad mi
 
 padString :: (TimeLocale -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
-padString ff = padGeneral False 1 ' ' $ \locale pado -> showPadded pado . ff locale
+padString ff = padGeneral False False 1 ' ' $ \locale pado -> showPadded pado . ff locale
 
 padNum :: (Show i,Ord i,Num i) => Bool -> Int -> Char -> (t -> i) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String)
-padNum fdef idef cdef ff = padGeneral fdef idef cdef $ \_ pado -> showPaddedNum pado . ff
+padNum fdef idef cdef ff = padGeneral False fdef idef cdef $ \_ pado -> showPaddedNum pado . ff
 
 -- <http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html>
 class FormatTime t where
@@ -168,10 +169,6 @@ formatChar c = case formatCharacter c of
 --
 -- [@%j@] day of year, 0-padded to three chars, @001@ - @366@
 --
--- [@%G@] year for Week Date format, no padding. Note @%0G@ and @%_G@ pad to four chars
---
--- [@%g@] year of century for Week Date format, 0-padded to two chars, @00@ - @99@
---
 -- [@%f@] century for Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars
 --
 -- [@%V@] week of year for Week Date format, 0-padded to two chars, @01@ - @53@
@@ -238,6 +235,16 @@ todAMPM locale day = let
 tod12Hour :: TimeOfDay -> Int
 tod12Hour day = (mod (todHour day - 1) 12) + 1
 
+showPaddedFixedFraction :: HasResolution a => PadOption -> Fixed a -> String
+showPaddedFixedFraction pado x = let
+    digits = dropWhile (=='.') $ dropWhile (/='.') $ showFixed True x
+    n = length digits
+    in case pado of
+        NoPad -> digits
+        Pad i c -> if i < n
+            then take i digits
+            else digits ++ replicate (i - n) c
+
 instance FormatTime TimeOfDay where
     -- Aggregate
     formatCharacter 'R' = Just $ padString $ \locale -> formatTime locale "%H:%M"
@@ -256,8 +263,8 @@ instance FormatTime TimeOfDay where
     formatCharacter 'M' = Just $ padNum True  2 '0' todMin
     -- Second
     formatCharacter 'S' = Just $ padNum True  2 '0' $ (truncate . todSec :: TimeOfDay -> Int)
-    formatCharacter 'q' = Just $ padGeneral True 12 '0' $ \_ pado -> drop 1 . dropWhile (/='.') . showPaddedFixed pado . todSec
-    formatCharacter 'Q' = Just $ padGeneral False 1 '0' $ \_ pado -> dropWhile (/='.') . showPaddedFixed pado . todSec
+    formatCharacter 'q' = Just $ padGeneral True True 12 '0' $ \_ pado -> showPaddedFixedFraction pado . todSec
+    formatCharacter 'Q' = Just $ padGeneral True False 12 '0' $ \_ pado -> ('.':) . showPaddedFixedFraction pado . todSec
 
     -- Default
     formatCharacter _   = Nothing
@@ -272,10 +279,10 @@ instance FormatTime ZonedTime where
             Nothing -> Nothing
 
 instance FormatTime TimeZone where
-    formatCharacter 'z' = Just $ padGeneral True  4 '0' $ \_ pado -> showPadded pado . timeZoneOffsetString' pado
+    formatCharacter 'z' = Just $ padGeneral False True  4 '0' $ \_ pado -> showPadded pado . timeZoneOffsetString' pado
     formatCharacter 'Z' = Just $ \locale mnpo mi z -> let
         n = timeZoneName z
-        in if null n then timeZoneOffsetString' (getPadOption True 4 '0' mnpo mi) z else padString (\_ -> timeZoneName) locale mnpo mi z
+        in if null n then timeZoneOffsetString' (getPadOption False True 4 '0' mnpo mi) z else padString (\_ -> timeZoneName) locale mnpo mi z
     formatCharacter _ = Nothing
 
 instance FormatTime Day where
index 35be9b1..1f8ec4a 100644 (file)
@@ -5,11 +5,13 @@ module Test.Format.Format(testFormat) where
 import Data.Time
 import Data.Time.Clock.POSIX
 import Data.Char
+import Data.Fixed
 import Foreign
 import Foreign.C
 import Test.QuickCheck hiding (Result)
 import Test.QuickCheck.Property
 import Test.Tasty
+import Test.Tasty.HUnit
 import Test.TestUtil
 import System.IO.Unsafe
 
@@ -125,5 +127,64 @@ testCompareHashFormat = tgroup hashformats $ \fmt -> do
     zone <- zones
     return $ compareFormat (fmap toLower) fmt zone time
 
+formatUnitTest :: String -> Pico -> String -> TestTree
+formatUnitTest fmt sec expected = nameTest (show fmt) $ let
+    tod = TimeOfDay 0 0 (1 + sec)
+    found = formatTime locale fmt tod
+    in assertEqual "" expected found
+
+testQs :: [TestTree]
+testQs = [
+    formatUnitTest "%q" 0 "000000000000",
+    formatUnitTest "%q" 0.37 "370000000000",
+    formatUnitTest "%0q" 0 "000000000000",
+    formatUnitTest "%0q" 0.37 "370000000000",
+    formatUnitTest "%_q" 0 "            ",
+    formatUnitTest "%_q" 0.37 "37          ",
+    formatUnitTest "%-q" 0 "",
+    formatUnitTest "%-q" 0.37 "37",
+    formatUnitTest "%1q" 0 "0",
+    formatUnitTest "%1q" 0.37 "3",
+    formatUnitTest "%01q" 0 "0",
+    formatUnitTest "%01q" 0.37 "3",
+    formatUnitTest "%_1q" 0 " ",
+    formatUnitTest "%_1q" 0.37 "3",
+    formatUnitTest "%-1q" 0 " ",
+    formatUnitTest "%-1q" 0.37 "3",
+    formatUnitTest "%5q" 0 "00000",
+    formatUnitTest "%5q" 0.37 "37000",
+    formatUnitTest "%05q" 0 "00000",
+    formatUnitTest "%05q" 0.37 "37000",
+    formatUnitTest "%_5q" 0 "     ",
+    formatUnitTest "%_5q" 0.37 "37   ",
+    formatUnitTest "%-5q" 0 "     ",
+    formatUnitTest "%-5q" 0.37 "37   ",
+
+    formatUnitTest "%Q" 0 ".",
+    formatUnitTest "%Q" 0.37 ".37",
+    formatUnitTest "%0Q" 0 ".000000000000",
+    formatUnitTest "%0Q" 0.37 ".370000000000",
+    formatUnitTest "%_Q" 0 ".            ",
+    formatUnitTest "%_Q" 0.37 ".37          ",
+    formatUnitTest "%-Q" 0 ".",
+    formatUnitTest "%-Q" 0.37 ".37",
+    formatUnitTest "%1Q" 0 ".0",
+    formatUnitTest "%1Q" 0.37 ".3",
+    formatUnitTest "%01Q" 0 ".0",
+    formatUnitTest "%01Q" 0.37 ".3",
+    formatUnitTest "%_1Q" 0 ". ",
+    formatUnitTest "%_1Q" 0.37 ".3",
+    formatUnitTest "%-1Q" 0 ". ",
+    formatUnitTest "%-1Q" 0.37 ".3",
+    formatUnitTest "%5Q" 0 ".00000",
+    formatUnitTest "%5Q" 0.37 ".37000",
+    formatUnitTest "%05Q" 0 ".00000",
+    formatUnitTest "%05Q" 0.37 ".37000",
+    formatUnitTest "%_5Q" 0 ".     ",
+    formatUnitTest "%_5Q" 0.37 ".37   ",
+    formatUnitTest "%-5Q" 0 ".     ",
+    formatUnitTest "%-5Q" 0.37 ".37   "
+    ]
+
 testFormat :: TestTree
-testFormat = testGroup "testFormat" $ testCompareFormat ++ testCompareHashFormat
+testFormat = testGroup "testFormat" $ testCompareFormat ++ testCompareHashFormat ++ testQs