diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +# Version 0.8.1 + +* Fix decimal rendering of some small cent values (e.g., `0.02`). See issue #45. + +* Fixed `xxxToDecimal` docs. See issue #45. + +* Add `someXxxToDecimal`. See issue #44. + + # Version 0.8 * _COMPILER ASSISTED BREAKING CHANGE_. Introduced `DecimalConf`, which all diff --git a/safe-money.cabal b/safe-money.cabal --- a/safe-money.cabal +++ b/safe-money.cabal @@ -1,8 +1,8 @@ name: safe-money -version: 0.8 +version: 0.8.1 license: BSD3 license-file: LICENSE -copyright: Copyright (c) Renzo Carbonara 2016-2018 +copyright: Copyright (c) Renzo Carbonara 2016-2019 author: Renzo Carbonara maintainer: renĪ»ren!zone stability: Experimental diff --git a/src/Money.hs b/src/Money.hs --- a/src/Money.hs +++ b/src/Money.hs @@ -84,6 +84,7 @@ , I.mkSomeDense , I.fromSomeDense , I.withSomeDense + , I.someDenseToDecimal , I.someDenseCurrency , I.someDenseAmount , I.SomeDiscrete @@ -91,6 +92,7 @@ , I.mkSomeDiscrete , I.fromSomeDiscrete , I.withSomeDiscrete + , I.someDiscreteToDecimal , I.someDiscreteCurrency , I.someDiscreteScale , I.someDiscreteAmount @@ -99,6 +101,7 @@ , I.mkSomeExchangeRate , I.fromSomeExchangeRate , I.withSomeExchangeRate + , I.someExchangeRateToDecimal , I.someExchangeRateSrcCurrency , I.someExchangeRateDstCurrency , I.someExchangeRateRate diff --git a/src/Money/Internal.hs b/src/Money/Internal.hs --- a/src/Money/Internal.hs +++ b/src/Money/Internal.hs @@ -65,6 +65,7 @@ , mkSomeDense' , fromSomeDense , withSomeDense + , someDenseToDecimal , someDenseCurrency , someDenseCurrency' , someDenseAmount @@ -74,6 +75,7 @@ , mkSomeDiscrete' , fromSomeDiscrete , withSomeDiscrete + , someDiscreteToDecimal , someDiscreteCurrency , someDiscreteCurrency' , someDiscreteScale @@ -84,6 +86,7 @@ , mkSomeExchangeRate' , fromSomeExchangeRate , withSomeExchangeRate + , someExchangeRateToDecimal , someExchangeRateSrcCurrency , someExchangeRateSrcCurrency' , someExchangeRateDstCurrency @@ -145,6 +148,7 @@ import qualified Test.QuickCheck as QC import qualified Text.ParserCombinators.ReadPrec as ReadPrec import qualified Text.ParserCombinators.ReadP as ReadP +import Text.Printf (printf) import qualified Text.Read as Read import Unsafe.Coerce (unsafeCoerce) @@ -531,7 +535,7 @@ :: forall currency scale . GoodScale scale => Approximation - -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in + -- ^ Approximation to use if necessary in order to fit the 'Dense' amount in -- the requested @scale@. -> Dense currency -> (Discrete' currency scale, Dense currency) @@ -1335,20 +1339,27 @@ -- \"1234.56\" -- @ denseToDecimal - :: DecimalConf - -- ^ Config to use for rendering the decimal number. + :: DecimalConf -- ^ Config to use for rendering the decimal number. -> Approximation - -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in + -- ^ Approximation to use if necessary in order to fit the 'Dense' amount in -- as many decimal numbers as requested. - -> Dense currency - -- ^ The dense monetary amount to render. + -> Dense currency -- ^ The monetary amount to render. -> T.Text - -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they - -- are digits, or they are equal). {-# INLINABLE denseToDecimal #-} -denseToDecimal ds a = \(Dense r0) -> do - rationalToDecimal ds a r0 +denseToDecimal dc a = \(Dense r0) -> + rationalToDecimal dc a r0 +-- | Like 'denseToDecimal', but takes a 'SomeDense' as input. +someDenseToDecimal + :: DecimalConf -- ^ Config to use for rendering the decimal number. + -> Approximation + -- ^ Approximation to use if necessary in order to fit the 'SomeDense' amount + -- in as many decimal numbers as requested. + -> SomeDense -- ^ The monetary amount to render. + -> T.Text +{-# INLINABLE someDenseToDecimal #-} +someDenseToDecimal dc a = \sd -> + withSomeDense sd (denseToDecimal dc a) -- | Render a 'Discrete'' monetary amount as a decimal number in a potentially -- lossy manner. @@ -1367,20 +1378,29 @@ -- Please refer to 'denseToDecimal' for further documentation. discreteToDecimal :: GoodScale scale - => DecimalConf - -- ^ Config to use for rendering the decimal number. + => DecimalConf -- ^ Config to use for rendering the decimal number. -> Approximation - -- ^ Approximation to use if necesary in order to fit the 'Discrete' amount in - -- as many decimal numbers as requested. + -- ^ Approximation to use if necessary in order to fit the 'Discrete' amount + -- in as many decimal numbers as requested. -> Discrete' currency scale -- ^ The monetary amount to render. -> T.Text - -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they - -- are digits, or they are equal). {-# INLINABLE discreteToDecimal #-} -discreteToDecimal ds a = \dns -> - denseToDecimal ds a (denseFromDiscrete dns) +discreteToDecimal dc a = \dns -> + denseToDecimal dc a (denseFromDiscrete dns) +-- | Like 'discreteToDecimal', but takes a 'SomeDiscrete' as input. +someDiscreteToDecimal + :: DecimalConf -- ^ Config to use for rendering the decimal number. + -> Approximation + -- ^ Approximation to use if necessary in order to fit the 'SomeDiscrete' + -- amount in as many decimal numbers as requested. + -> SomeDiscrete -- ^ The monetary amount to render. + -> T.Text +{-# INLINABLE someDiscreteToDecimal #-} +someDiscreteToDecimal dc a = \sd -> + withSomeDiscrete sd (discreteToDecimal dc a) + -- | Render a 'ExchangeRate' as a decimal number in a potentially lossy manner. -- -- @ @@ -1389,20 +1409,28 @@ -- Just \"1,234.56\" -- @ exchangeRateToDecimal - :: DecimalConf - -- ^ Config to use for rendering the decimal number. + :: DecimalConf -- ^ Config to use for rendering the decimal number. -> Approximation - -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in - -- as many decimal numbers as requested. - -> ExchangeRate src dst - -- ^ The 'ExchangeRate' to render. + -- ^ Approximation to use if necessary in order to fit the 'ExchangeRate' + -- amount in as many decimal numbers as requested. + -> ExchangeRate src dst -- ^ The 'ExchangeRate' to render. -> T.Text - -- ^ Returns 'Nothing' if the given separators are not acceptable (i.e., they - -- are digits, or they are equal). {-# INLINABLE exchangeRateToDecimal #-} -exchangeRateToDecimal ds a = \(ExchangeRate r0) -> - rationalToDecimal ds a r0 +exchangeRateToDecimal dc a = \(ExchangeRate r0) -> + rationalToDecimal dc a r0 +-- | Like 'exchangeRateToDecimal', but takes a 'SomeExchangeRate' as input. +someExchangeRateToDecimal + :: DecimalConf -- ^ Config to use for rendering the decimal number. + -> Approximation + -- ^ Approximation to use if necessary in order to fit the 'SomeExchangeRate' + -- amount in as many decimal numbers as requested. + -> SomeExchangeRate -- ^ The 'SomeExchangeRate' to render. + -> T.Text +{-# INLINABLE someExchangeRateToDecimal #-} +someExchangeRateToDecimal dc a = \ser -> + withSomeExchangeRate ser (exchangeRateToDecimal dc a) + -------------------------------------------------------------------------------- -- | Decimal and thousands separators used when rendering or parsing a decimal @@ -1414,7 +1442,7 @@ -- | Construct 'Separators' to use with in 'DecimalConf'. -- --- The separatorsA can't be an ASCII digit nor control character, and they must +-- The separators can't be an ASCII digit nor control character, and they must -- be different from each other. mkSeparators :: Char @@ -1562,31 +1590,27 @@ :: DecimalConf -- ^ Config to use for rendering the decimal number. -> Approximation - -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in + -- ^ Approximation to use if necessary in order to fit the 'Dense' amount in -- as many decimal numbers as requested. -> Rational -- ^ The dense monetary amount to render. -> T.Text - -- ^ Returns 'Nothing' if the given separators are not acceptable (i.e., they - -- are digits, or they are equal). {-# INLINABLE rationalToDecimal #-} -rationalToDecimal (DecimalConf (Separators ds yts) plus fdigs0 scal) a = \r0 -> do - -- this string-fu is not particularly efficient. - let start = r0 * scaleToRational scal * (10 ^ fdigs0) :: Rational +rationalToDecimal (DecimalConf (Separators ds yts) plus fdigs sc) a = \r0 -> do + -- This string-fu is not particularly efficient. TODO: Make fast. + let start = r0 * scaleToRational sc * (10 ^ fdigs) :: 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)) + ipart = fromInteger (abs parts) `div` (10 ^ fdigs) :: Natural + ftext | ipart == 0 = printf ("%0." <> show fdigs <> "d") (abs parts) + | otherwise = drop (length (show ipart)) (show (abs parts)) :: String itext = maybe (show ipart) (renderThousands ipart) yts :: String - fpad0 = List.replicate (fromIntegral fdigs0 - length ftext) '0' :: String + fpadr = List.replicate (fromIntegral fdigs - length ftext) '0' :: String T.pack $ mconcat [ if | parts < 0 -> "-" | plus && parts > 0 -> "+" | otherwise -> "" , itext - , if | fdigs0 > 0 -> ds : if start < 1 - then fpad0 <> ftext - else ftext <> fpad0 + , if | fdigs > 0 -> ds : ftext <> fpadr | otherwise -> "" ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -100,9 +100,36 @@ , testDiscrete (Proxy :: Proxy "VUV") (Proxy :: Proxy "vatu") , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "gram") , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "grain") + , testDiscreteBase10 (Proxy :: Proxy "BTC") (Proxy :: Proxy "satoshi") + , testDiscreteBase10 (Proxy :: Proxy "BTC") (Proxy :: Proxy "bitcoin") + , testDiscreteBase10 (Proxy :: Proxy "USD") (Proxy :: Proxy "cent") + , testDiscreteBase10 (Proxy :: Proxy "USD") (Proxy :: Proxy "dollar") + , testDiscreteBase10 (Proxy :: Proxy "VUV") (Proxy :: Proxy "vatu") ] +testDiscreteBase10 + :: forall (currency :: Symbol) (unit :: Symbol) + . ( Money.GoodScale (Money.UnitScale currency unit) + , KnownSymbol currency + , KnownSymbol unit ) + => Proxy currency + -> Proxy unit + -> Tasty.TestTree +testDiscreteBase10 _ _= + Tasty.testGroup "Discrete (scale base 10)" + [ Tasty.localOption (QC.QuickCheckTests 5000) $ + QC.testProperty "discreteToDecimal/discreteFromDecimal: roundtrip" $ + QC.forAll QC.arbitrary $ \(dis0 :: Money.Discrete currency unit) -> + let fdigs = ceiling (logBase 10 (fromRational + (Money.scaleToRational (Money.scale dis0)))) + in (fdigs <= fromIntegral (maxBound :: Word8)) + ==> let dc = Money.defaultDecimalConf + { Money.decimalConf_digits = fromIntegral fdigs } + dec = Money.discreteToDecimal dc Money.Round dis0 + in Just dis0 === Money.discreteFromDecimal dc dec + ] + testRationalToDecimal :: Tasty.TestTree testRationalToDecimal = Tasty.testGroup "rationalToDecimal" @@ -216,6 +243,28 @@ , "0" -- 6 , "0" -- 7 ] + , HU.testCase "Round: r6" $ do + render Money.Round r6 @?= + [ "0.02" -- 0 + , "0.02" -- 1 + , "+0.02" -- 2 + , "+0.02" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] + , HU.testCase "Round: negate r6" $ do + render Money.Round (negate r6) @?= + [ "-0.02" -- 0 + , "-0.02" -- 1 + , "-0.02" -- 2 + , "-0.02" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] , HU.testCase "Floor: r1" $ do render Money.Floor r1 @?= @@ -327,6 +376,28 @@ , "-1" -- 6 , "-1" -- 7 ] + , HU.testCase "Floor: r6" $ do + render Money.Floor r6 @?= + [ "0.02" -- 0 + , "0.02" -- 1 + , "+0.02" -- 2 + , "+0.02" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] + , HU.testCase "Floor: negate r6" $ do + render Money.Floor (negate r6) @?= + [ "-0.02" -- 0 + , "-0.02" -- 1 + , "-0.02" -- 2 + , "-0.02" -- 3 + , "-1" -- 4 + , "-1" -- 5 + , "-1" -- 6 + , "-1" -- 7 + ] , HU.testCase "Ceiling: r1" $ do render Money.Ceiling r1 @?= @@ -438,6 +509,28 @@ , "0" -- 6 , "0" -- 7 ] + , HU.testCase "Ceiling: r6" $ do + render Money.Ceiling r6 @?= + [ "0.02" -- 0 + , "0.02" -- 1 + , "+0.02" -- 2 + , "+0.02" -- 3 + , "1" -- 4 + , "1" -- 5 + , "+1" -- 6 + , "+1" -- 7 + ] + , HU.testCase "Ceiling: negate r6" $ do + render Money.Ceiling (negate r6) @?= + [ "-0.02" -- 0 + , "-0.02" -- 1 + , "-0.02" -- 2 + , "-0.02" -- 3 + , "0" -- 4 + , "0" -- 5 + , "0" -- 6 + , "0" -- 7 + ] , HU.testCase "Truncate: r1" $ do render Money.Truncate r1 @?= render Money.Floor r1 @@ -469,6 +562,12 @@ , HU.testCase "Truncate: negate r5" $ do render Money.Truncate (negate r5) @?= render Money.Ceiling (negate r5) + , HU.testCase "Truncate: r6" $ do + render Money.Truncate r6 @?= render Money.Floor r6 + + , HU.testCase "Truncate: negate r6" $ do + render Money.Truncate (negate r6) @?= render Money.Ceiling (negate r6) + , HU.testCase "HalfEven: r1" $ do render Money.HalfEven r1 @?= render Money.Round r1 @@ -516,6 +615,12 @@ , "0" -- 7 ] + , HU.testCase "HalfEven: r6" $ do + render Money.HalfEven r6 @?= render Money.Round r6 + + , HU.testCase "HalfEven: negate r6" $ do + render Money.HalfEven (negate r6) @?= render Money.Round (negate r6) + ] where r1 :: Rational = 1023004567895 % 1000 @@ -523,6 +628,7 @@ r3 :: Rational = 345 % 1000 r4 :: Rational = 7 % 1000 r5 :: Rational = 1 % 2 + r6 :: Rational = 2 % 100 render :: Money.Approximation -> Rational -> [T.Text] render a r = @@ -569,7 +675,7 @@ ds1 = ds0 { Money.decimalConf_scale = sr } dec = MoneyI.rationalToDecimal ds1 aprox r Just r' = MoneyI.rationalFromDecimal ds1 dec - in 1 > abs (abs r - abs r') + in (1 / Money.scaleToRational sr) > abs (abs r - abs r') ] testDense @@ -630,7 +736,7 @@ Just dns = Money.denseFromDecimal ds dec in r === toRational (dns :: Money.Dense currency) - , Tasty.localOption (QC.QuickCheckTests 1000) $ + , Tasty.localOption (QC.QuickCheckTests 5000) $ QC.testProperty "denseToDecimal/denseFromDiscrete: Lossy roundtrip" $ -- We check that the roundtrip results in a close amount with a fractional -- difference of up to one.