diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Change Log +## [1.8.0.4] +- Fix "show minBound" bug +- haddock: example for parseTimeM + ## [1.8.0.3] - Add "Quick start" documentation diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -AC_INIT([Haskell time package], [1.8.0.3], [ashley@semantic.org], [time]) +AC_INIT([Haskell time package], [1.8.0.4], [ashley@semantic.org], [time]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([lib/include/HsTime.h]) diff --git a/lib/Data/Time/Calendar/Private.hs b/lib/Data/Time/Calendar/Private.hs --- a/lib/Data/Time/Calendar/Private.hs +++ b/lib/Data/Time/Calendar/Private.hs @@ -9,22 +9,31 @@ showPadded NoPad s = s showPadded (Pad i c) s = replicate (i - length s) c ++ s -showPaddedNum :: (Num t,Ord t,Show t) => PadOption -> t -> String -showPaddedNum NoPad i = show i -showPaddedNum pad i | i < 0 = '-':(showPaddedNum pad (negate i)) -showPaddedNum pad i = showPadded pad $ show i +class (Num t,Ord t,Show t) => ShowPadded t where + showPaddedNum :: PadOption -> t -> String +instance ShowPadded Integer where + showPaddedNum NoPad i = show i + showPaddedNum pad i | i < 0 = '-':(showPaddedNum pad (negate i)) + showPaddedNum pad i = showPadded pad $ show i + +instance ShowPadded Int where + showPaddedNum NoPad i = show i + showPaddedNum _pad i | i == minBound = show i + showPaddedNum pad i | i < 0 = '-':(showPaddedNum pad (negate i)) + showPaddedNum pad i = showPadded pad $ show i + show2Fixed :: Pico -> String show2Fixed x | x < 10 = '0':(showFixed True x) show2Fixed x = showFixed True x -show2 :: (Num t,Ord t,Show t) => t -> String +show2 :: (ShowPadded t) => t -> String show2 = showPaddedNum $ Pad 2 '0' -show3 :: (Num t,Ord t,Show t) => t -> String +show3 :: (ShowPadded t) => t -> String show3 = showPaddedNum $ Pad 3 '0' -show4 :: (Num t,Ord t,Show t) => t -> String +show4 :: (ShowPadded t) => t -> String show4 = showPaddedNum $ Pad 4 '0' mod100 :: (Integral i) => i -> i diff --git a/lib/Data/Time/Format.hs b/lib/Data/Time/Format.hs --- a/lib/Data/Time/Format.hs +++ b/lib/Data/Time/Format.hs @@ -52,7 +52,7 @@ padString :: (TimeLocale -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String) 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 :: (ShowPadded i) => Bool -> Int -> Char -> (t -> i) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String) padNum fdef idef cdef ff = padGeneral False fdef idef cdef $ \_ pado -> showPaddedNum pado . ff -- diff --git a/lib/Data/Time/Format/Parse.hs b/lib/Data/Time/Format/Parse.hs --- a/lib/Data/Time/Format/Parse.hs +++ b/lib/Data/Time/Format/Parse.hs @@ -92,6 +92,13 @@ -- -- [@%0f@] accepts exactly two digits. -- +-- For example, to parse a date in YYYY-MM-DD format, while allowing the month +-- and date to have optional leading zeros (notice the @-@ modifier used for @%m@ +-- and @%d@): +-- +-- > Prelude Data.Time> parseTimeM True defaultTimeLocale "%Y-%-m-%-d" "2010-3-04" :: Maybe Day +-- > Just 2010-03-04 +-- parseTimeM :: (Monad m,ParseTime t) => Bool -- ^ Accept leading and trailing whitespace? -> TimeLocale -- ^ Time locale. diff --git a/test/main/Test/Format/ParseTime.hs b/test/main/Test/Format/ParseTime.hs --- a/test/main/Test/Format/ParseTime.hs +++ b/test/main/Test/Format/ParseTime.hs @@ -61,7 +61,7 @@ found = reads target result = assertEqual "" expected found name = show target - in testCase name result + in Test.Tasty.HUnit.testCase name result readTestsParensSpaces :: forall a. (Eq a,Show a,Read a) => a -> String -> TestTree readTestsParensSpaces expected target = testGroup target @@ -127,7 +127,7 @@ found = readSTime False defaultTimeLocale formatStr target result = assertEqual "" expected found name = (show formatStr) ++ " of " ++ (show target) - in testCase name result + in Test.Tasty.HUnit.testCase name result spacingTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> TestTree spacingTests expected formatStr target = testGroup "particular" @@ -198,7 +198,7 @@ found = parse sp formatStr target result = assertEqual "" expected found name = (show formatStr) ++ " of " ++ (show target) ++ (if sp then " allowing spaces" else "") - in testCase name result + in Test.Tasty.HUnit.testCase name result {- readsTest :: forall t. (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> TestTree readsTest (Just e) = readsTest' [(e,"")] diff --git a/test/main/Test/LocalTime/Time.hs b/test/main/Test/LocalTime/Time.hs --- a/test/main/Test/LocalTime/Time.hs +++ b/test/main/Test/LocalTime/Time.hs @@ -100,7 +100,9 @@ in unlines [ show $ f $ TimeOfDay 12 34 56.789 , show $ f $ TimeOfDay 12 34 56.789123 , show $ f $ TimeOfDay 12 34 56.789123456 - , show $ f $ TimeOfDay 12 34 56.789123456789 ] + , show $ f $ TimeOfDay 12 34 56.789123456789 + , show $ f $ TimeOfDay minBound 0 0 + ] testTime :: TestTree testTime = testCase "testTime" $ diff --git a/test/main/Test/LocalTime/TimeRef.hs b/test/main/Test/LocalTime/TimeRef.hs --- a/test/main/Test/LocalTime/TimeRef.hs +++ b/test/main/Test/LocalTime/TimeRef.hs @@ -1,5 +1,13 @@ module Test.LocalTime.TimeRef where +import Data.Int + +is64Bit :: Bool +is64Bit = + if toInteger (maxBound :: Int) == toInteger (maxBound :: Int32) then False else + if toInteger (maxBound :: Int) == toInteger (maxBound :: Int64) then True else + error "unrecognised Int size" + testTimeRef :: String testTimeRef = unlines [ @@ -878,4 +886,5 @@ ,"12:34:56.789123" ,"12:34:56.789123456" ,"12:34:56.789123456789" + ,if is64Bit then "-9223372036854775808:00:00" else "-2147483648:00:00" ,"" ] diff --git a/test/main/Test/TestUtil.hs b/test/main/Test/TestUtil.hs --- a/test/main/Test/TestUtil.hs +++ b/test/main/Test/TestUtil.hs @@ -21,7 +21,7 @@ nameTest = testGroup instance NameTest Assertion where - nameTest = testCase + nameTest = Test.Tasty.HUnit.testCase instance NameTest Property where nameTest = testProperty diff --git a/test/unix/Test/TestUtil.hs b/test/unix/Test/TestUtil.hs --- a/test/unix/Test/TestUtil.hs +++ b/test/unix/Test/TestUtil.hs @@ -21,7 +21,7 @@ nameTest = testGroup instance NameTest Assertion where - nameTest = testCase + nameTest = Test.Tasty.HUnit.testCase instance NameTest Property where nameTest = testProperty diff --git a/time.cabal b/time.cabal --- a/time.cabal +++ b/time.cabal @@ -1,5 +1,5 @@ name: time -version: 1.8.0.3 +version: 1.8.0.4 stability: stable license: BSD3 license-file: LICENSE