diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,11 @@ +# Version 0.7.1 + +* Fixed compilation with GHC 8.6. + +* Fixed an issue when rendering decimal values smaller than the smallest + possible fractional part. (Issue #39) + + # Version 0.7 * _IMPORTANT_. All of the changes in this release are fully backwards diff --git a/safe-money.cabal b/safe-money.cabal --- a/safe-money.cabal +++ b/safe-money.cabal @@ -1,5 +1,5 @@ name: safe-money -version: 0.7 +version: 0.7.1 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2016-2018 diff --git a/src/Money/Internal.hs b/src/Money/Internal.hs --- a/src/Money/Internal.hs +++ b/src/Money/Internal.hs @@ -1455,7 +1455,8 @@ for_ ytsep $ \tsep -> guard (tsep /= dsep && not (Char.isDigit tsep)) -- this string-fu is not particularly efficient. - let parts = approximate a (r0 * (10 ^ fdigs0)) :: Integer + let start = r0 * (10 ^ fdigs0) :: Rational + parts = approximate a start :: Integer ipart = fromInteger (abs parts) `div` (10 ^ fdigs0) :: Natural ftext | ipart == 0 = show (abs parts) :: String | otherwise = drop (length (show ipart)) (show (abs parts)) @@ -1466,7 +1467,9 @@ | plus && parts > 0 -> "+" | otherwise -> "" , itext - , if | fdigs0 > 0 -> dsep : ftext <> fpad0 + , if | fdigs0 > 0 -> dsep : if start < 1 + then fpad0 <> ftext + else ftext <> fpad0 | otherwise -> "" ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -17,7 +17,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Char as Char -import Data.Maybe (catMaybes, isJust, isNothing, fromJust) +import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing) import Data.Proxy (Proxy(Proxy)) import Data.Ratio ((%), numerator, denominator) import qualified Data.Text as T @@ -49,7 +49,10 @@ digs :: Word8 <- QC.arbitrary r :: Rational <- (%) <$> QC.arbitrary <*> QC.suchThat QC.arbitrary (/= 0) (yts, ds) <- genDecimalSeps - Just dec <- pure (MoneyI.rationalToDecimal aprox plus yts ds digs r) + let + dec = fromMaybe + (error "genDecimal failed because rationalToDecimal returned Nothing") + (MoneyI.rationalToDecimal aprox plus yts ds digs r) pure (dec, yts, ds) -- | Generates valid separators for decimal representations (see genDecimal). @@ -117,10 +120,10 @@ , "1,023,004,567.90" -- 1 , "+1023004567.90" -- 2 , "+1,023,004,567.90" -- 3 - , "1023004568" -- 8 - , "1,023,004,568" -- 9 - , "+1023004568" -- 10 - , "+1,023,004,568" -- 11 + , "1023004568" -- 4 + , "1,023,004,568" -- 5 + , "+1023004568" -- 6 + , "+1,023,004,568" -- 7 ] , HU.testCase "Round: negate r1" $ do render Money.Round (negate r1) @?= @@ -128,10 +131,10 @@ , "-1,023,004,567.90" -- 1 , "-1023004567.90" -- 2 , "-1,023,004,567.90" -- 3 - , "-1023004568" -- 8 - , "-1,023,004,568" -- 9 - , "-1023004568" -- 10 - , "-1,023,004,568" -- 11 + , "-1023004568" -- 4 + , "-1,023,004,568" -- 5 + , "-1023004568" -- 6 + , "-1,023,004,568" -- 7 ] , HU.testCase "Round: r2" $ do render Money.Round r2 @?= @@ -139,10 +142,10 @@ , "1.23" -- 1 , "+1.23" -- 2 , "+1.23" -- 3 - , "1" -- 8 - , "1" -- 9 - , "+1" -- 10 - , "+1" -- 11 + , "1" -- 4 + , "1" -- 5 + , "+1" -- 6 + , "+1" -- 7 ] , HU.testCase "Round: negate r2" $ do render Money.Round (negate r2) @?= @@ -150,10 +153,10 @@ , "-1.23" -- 1 , "-1.23" -- 2 , "-1.23" -- 3 - , "-1" -- 8 - , "-1" -- 9 - , "-1" -- 10 - , "-1" -- 11 + , "-1" -- 4 + , "-1" -- 5 + , "-1" -- 6 + , "-1" -- 7 ] , HU.testCase "Round: r3" $ do render Money.Round r3 @?= @@ -161,10 +164,10 @@ , "0.34" -- 1 , "+0.34" -- 2 , "+0.34" -- 3 - , "0" -- 8 - , "0" -- 9 - , "0" -- 10 - , "0" -- 11 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 ] , HU.testCase "Round: negate r3" $ do render Money.Round (negate r3) @?= @@ -172,21 +175,43 @@ , "-0.34" -- 1 , "-0.34" -- 2 , "-0.34" -- 3 - , "0" -- 8 - , "0" -- 9 - , "0" -- 10 - , "0" -- 11 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 ] + , HU.testCase "Round: r4" $ do + render Money.Round r4 @?= + [ "0.01" -- 0 + , "0.01" -- 1 + , "+0.01" -- 2 + , "+0.01" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] + , HU.testCase "Round: negate r4" $ do + render Money.Round (negate r4) @?= + [ "-0.01" -- 0 + , "-0.01" -- 1 + , "-0.01" -- 2 + , "-0.01" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] , HU.testCase "Floor: r1" $ do render Money.Floor r1 @?= [ "1023004567.89" -- 0 , "1,023,004,567.89" -- 1 , "+1023004567.89" -- 2 , "+1,023,004,567.89" -- 3 - , "1023004567" -- 8 - , "1,023,004,567" -- 9 - , "+1023004567" -- 10 - , "+1,023,004,567" -- 11 + , "1023004567" -- 4 + , "1,023,004,567" -- 5 + , "+1023004567" -- 6 + , "+1,023,004,567" -- 7 ] , HU.testCase "Floor: negate r1" $ do render Money.Floor (negate r1) @?= @@ -194,10 +219,10 @@ , "-1,023,004,567.90" -- 1 , "-1023004567.90" -- 2 , "-1,023,004,567.90" -- 3 - , "-1023004568" -- 8 - , "-1,023,004,568" -- 9 - , "-1023004568" -- 10 - , "-1,023,004,568" -- 11 + , "-1023004568" -- 4 + , "-1,023,004,568" -- 5 + , "-1023004568" -- 6 + , "-1,023,004,568" -- 7 ] , HU.testCase "Floor: r2" $ do render Money.Floor r2 @?= @@ -205,10 +230,10 @@ , "1.23" -- 1 , "+1.23" -- 2 , "+1.23" -- 3 - , "1" -- 8 - , "1" -- 9 - , "+1" -- 10 - , "+1" -- 11 + , "1" -- 4 + , "1" -- 5 + , "+1" -- 6 + , "+1" -- 7 ] , HU.testCase "Floor: negate r2" $ do render Money.Floor (negate r2) @?= @@ -216,10 +241,10 @@ , "-1.23" -- 1 , "-1.23" -- 2 , "-1.23" -- 3 - , "-2" -- 8 - , "-2" -- 9 - , "-2" -- 10 - , "-2" -- 11 + , "-2" -- 4 + , "-2" -- 5 + , "-2" -- 6 + , "-2" -- 7 ] , HU.testCase "Floor: r3" $ do render Money.Floor r3 @?= @@ -227,10 +252,10 @@ , "0.34" -- 1 , "+0.34" -- 2 , "+0.34" -- 3 - , "0" -- 8 - , "0" -- 9 - , "0" -- 10 - , "0" -- 11 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 ] , HU.testCase "Floor: negate r3" $ do render Money.Floor (negate r3) @?= @@ -238,21 +263,44 @@ , "-0.35" -- 1 , "-0.35" -- 2 , "-0.35" -- 3 - , "-1" -- 8 - , "-1" -- 9 - , "-1" -- 10 - , "-1" -- 11 + , "-1" -- 4 + , "-1" -- 5 + , "-1" -- 6 + , "-1" -- 7 ] + , HU.testCase "Floor: r4" $ do + render Money.Floor r4 @?= + [ "0.00" -- 0 + , "0.00" -- 1 + , "0.00" -- 2 + , "0.00" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] + , HU.testCase "Floor: negate r4" $ do + render Money.Floor (negate r4) @?= + [ "-0.01" -- 0 + , "-0.01" -- 1 + , "-0.01" -- 2 + , "-0.01" -- 3 + , "-1" -- 4 + , "-1" -- 5 + , "-1" -- 6 + , "-1" -- 7 + ] + , HU.testCase "Ceiling: r1" $ do render Money.Ceiling r1 @?= [ "1023004567.90" -- 0 , "1,023,004,567.90" -- 1 , "+1023004567.90" -- 2 , "+1,023,004,567.90" -- 3 - , "1023004568" -- 8 - , "1,023,004,568" -- 9 - , "+1023004568" -- 10 - , "+1,023,004,568" -- 11 + , "1023004568" -- 4 + , "1,023,004,568" -- 5 + , "+1023004568" -- 6 + , "+1,023,004,568" -- 7 ] , HU.testCase "Ceiling: negate r1" $ do render Money.Ceiling (negate r1) @?= @@ -260,10 +308,10 @@ , "-1,023,004,567.89" -- 1 , "-1023004567.89" -- 2 , "-1,023,004,567.89" -- 3 - , "-1023004567" -- 8 - , "-1,023,004,567" -- 9 - , "-1023004567" -- 10 - , "-1,023,004,567" -- 11 + , "-1023004567" -- 4 + , "-1,023,004,567" -- 5 + , "-1023004567" -- 6 + , "-1,023,004,567" -- 7 ] , HU.testCase "Ceiling: r2" $ do render Money.Ceiling r2 @?= @@ -271,10 +319,10 @@ , "1.23" -- 1 , "+1.23" -- 2 , "+1.23" -- 3 - , "2" -- 8 - , "2" -- 9 - , "+2" -- 10 - , "+2" -- 11 + , "2" -- 4 + , "2" -- 5 + , "+2" -- 6 + , "+2" -- 7 ] , HU.testCase "Ceiling: negate r2" $ do render Money.Ceiling (negate r2) @?= @@ -282,10 +330,10 @@ , "-1.23" -- 1 , "-1.23" -- 2 , "-1.23" -- 3 - , "-1" -- 8 - , "-1" -- 9 - , "-1" -- 10 - , "-1" -- 11 + , "-1" -- 4 + , "-1" -- 5 + , "-1" -- 6 + , "-1" -- 7 ] , HU.testCase "Ceiling: r3" $ do render Money.Ceiling r3 @?= @@ -293,10 +341,10 @@ , "0.35" -- 1 , "+0.35" -- 2 , "+0.35" -- 3 - , "1" -- 8 - , "1" -- 9 - , "+1" -- 10 - , "+1" -- 11 + , "1" -- 4 + , "1" -- 5 + , "+1" -- 6 + , "+1" -- 7 ] , HU.testCase "Ceiling: negate r3" $ do render Money.Ceiling (negate r3) @?= @@ -304,11 +352,33 @@ , "-0.34" -- 1 , "-0.34" -- 2 , "-0.34" -- 3 - , "0" -- 8 - , "0" -- 9 - , "0" -- 10 - , "0" -- 11 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 ] + , HU.testCase "Ceiling: r4" $ do + render Money.Ceiling r4 @?= + [ "0.01" -- 0 + , "0.01" -- 1 + , "+0.01" -- 2 + , "+0.01" -- 3 + , "1" -- 4 + , "1" -- 5 + , "+1" -- 6 + , "+1" -- 7 + ] + , HU.testCase "Ceiling: negate r4" $ do + render Money.Ceiling (negate r4) @?= + [ "0.00" -- 0 + , "0.00" -- 1 + , "0.00" -- 2 + , "0.00" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] , HU.testCase "Truncate: r1" $ do render Money.Truncate r1 @?= render Money.Floor r1 @@ -327,11 +397,18 @@ , HU.testCase "Truncate: negate r3" $ do render Money.Truncate (negate r3) @?= render Money.Ceiling (negate r3) + + , HU.testCase "Truncate: r4" $ do + render Money.Truncate r4 @?= render Money.Floor r4 + + , HU.testCase "Truncate: negate r4" $ do + render Money.Truncate (negate r4) @?= render Money.Ceiling (negate r4) ] where r1 :: Rational = 1023004567895 % 1000 r2 :: Rational = 123 % 100 r3 :: Rational = 345 % 1000 + r4 :: Rational = 7 % 1000 render :: Money.Approximation -> Rational -> [T.Text] render a r = @@ -339,10 +416,10 @@ , fromJust $ MoneyI.rationalToDecimal a False (Just ',') '.' 2 r -- 1 , fromJust $ MoneyI.rationalToDecimal a True Nothing '.' 2 r -- 2 , fromJust $ MoneyI.rationalToDecimal a True (Just ',') '.' 2 r -- 3 - , fromJust $ MoneyI.rationalToDecimal a False Nothing '.' 0 r -- 8 - , fromJust $ MoneyI.rationalToDecimal a False (Just ',') '.' 0 r -- 9 - , fromJust $ MoneyI.rationalToDecimal a True Nothing '.' 0 r -- 10 - , fromJust $ MoneyI.rationalToDecimal a True (Just ',') '.' 0 r -- 11 + , fromJust $ MoneyI.rationalToDecimal a False Nothing '.' 0 r -- 4 + , fromJust $ MoneyI.rationalToDecimal a False (Just ',') '.' 0 r -- 5 + , fromJust $ MoneyI.rationalToDecimal a True Nothing '.' 0 r -- 6 + , fromJust $ MoneyI.rationalToDecimal a True (Just ',') '.' 0 r -- 7 ] testRationalFromDecimal :: Tasty.TestTree