safe-money 0.7 → 0.7.1
raw patch · 4 files changed
+169/−81 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Money: type family ErrScaleNonCanonical (currency :: Symbol) :: k
Files
- changelog.md +8/−0
- safe-money.cabal +1/−1
- src/Money/Internal.hs +5/−2
- test/Main.hs +155/−78
changelog.md view
@@ -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
safe-money.cabal view
@@ -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
src/Money/Internal.hs view
@@ -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 -> "" ]
test/Main.hs view
@@ -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