diff --git a/Decimal.cabal b/Decimal.cabal --- a/Decimal.cabal +++ b/Decimal.cabal @@ -1,24 +1,24 @@ Name: Decimal -Version: 0.3.1 +Version: 0.5.2 License: BSD3 License-file: LICENSE.txt -Copyright: Paul Johnson, 2013 +Copyright: Paul Johnson, 2013, 2018, 2021. Author: Paul Johnson Maintainer: paul@cogito.org.uk Stability: beta Category: Math -Cabal-version: >=1.10 +Cabal-version: 1.18 Build-type: Simple Synopsis: Decimal numbers with variable precision Description: A decimal number has an integer mantissa and a negative exponent. The exponent can be interpreted as the number of decimal places in the value. -Extra-source-files: README.txt -tested-with: GHC==7.4.2 +tested-with: GHC==8.2.2, GHC==8.10.4 homepage: https://github.com/PaulJohnson/Haskell-Decimal +extra-doc-files: LICENSE.txt, README.md, changelog.md -library - build-depends: +library + build-depends: base >= 4 && < 5, deepseq hs-source-dirs: src @@ -30,7 +30,7 @@ test-suite Main type: exitcode-stdio-1.0 x-uses-tf: true - build-depends: + build-depends: base >= 4 && < 5, HUnit >= 1.2 && < 2, QuickCheck >= 2.4, @@ -45,4 +45,4 @@ -- default-language: Haskell2010 default-language: Haskell2010 main-is: Main.hs - + other-modules: Data.Decimal diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,32 @@ +Haskell-Decimal +=============== + +Fixed-precision decimal numbers, where the precision is carried with the numbers at run-time. + +The `Decimal` type is mainly intended for doing financial arithmetic +where the number of decimal places may not be known at compile time +(e.g. for a program that handles both Yen and Dollars) and the +application must not drop pennies on the floor. For instance if you +have to divide $10 between three people then one of them has to get +$3.34. + +The number of decimal places in a value is represented as a Word8, +allowing for up to 255 decimal places. Functions preserve precision. +Addition and subtraction operators return a result with the precision of the most +precise argument, so 2.3 + 5.678 = 7.978. Multiplication and division use whatever precision is +necessary up to 255 decimal places. + + +QuickCheck Specification +------------------------ + +Data.Decimal includes a set of QuickCheck properties which act as both +tests and a formal specification. To run the tests do: + + cabal configure --enable-tests + cabal build + cabal test + +or + + stack test diff --git a/README.txt b/README.txt deleted file mode 100644 --- a/README.txt +++ /dev/null @@ -1,59 +0,0 @@ -Variable Precision Decimal Numbers -================================== - -The "Decimal" type is mainly intended for doing financial arithmetic -where the number of decimal places may not be known at compile time -(e.g. for a program that handles both Yen and Dollars) and the -application must not drop pennies on the floor. For instance if you -have to divide $10 between three people then one of them has to get -$3.34. - -The number of decimal places in a value is represented as a Word8, -allowing for up to 255 decimal places. Functions preserve precision. -Binary operators return a result with the precision of the most -precise argument, so 2.3 + 5.678 = 7.978. - -If you need fixed precision decimal arithmetic where the precision is -known at compile time then Data.Number.Fixed from Lennart Augustsson's -"numbers" package is more likely to be what you want. - -QuickCheck Specification ------------------------- - -Data.Decimal includes a set of QuickCheck properties which act as both -tests and a formal specification. To run the tests do: - - cabal configure --enable-tests - cabal build - cabal test - -Data.Decimal is an instance of Arbitrary, for your convenience in -writing your own tests. - - -Version 0.2.1 -------------- - -Fixed "base" dependency. -Put test suite under "cabal test" - -Version 0.2.2 -------------- - -Minor fixes to allow compilation under other versions of GHC. - -Version 0.2.3 -------------- - -Added instance of NFData from Control.DeepSeq, and hence a dependency -on the deepseq package, thanks to Jeff Shaw (shawjef3 at msu.edu). - -Version 0.3.1 -------------- - -Added Typeable, Fractional and RealFrac instances. -Multiplication now returns an exact result, increasing precision if necessary. - -These changes alter the API. Hence the increment to the major version number. - -Thanks to Alexey Uimanov (s9gf4ult at gmail.com). diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,58 @@ +Version 0.2.1 +------------- + +* Fixed `base` dependency. + +* Put test suite under `cabal test` + +Version 0.2.2 +------------- + +* Minor fixes to allow compilation under other versions of GHC. + +Version 0.2.3 +------------- + +* Added instance of `NFData` from `Control.DeepSeq`, and hence a dependency +on the `deepseq` package, thanks to Jeff Shaw (shawjef3 at msu.edu). + +Version 0.3.1 +------------- + +* Added `Typeable`, `Fractional` and `RealFrac` instances. + +* Multiplication now returns an exact result, increasing precision if necessary. + +These changes alter the API. Hence the increment to the major version number. + +Thanks to Alexey Uimanov (s9gf4ult at gmail.com). + +Version 0.4.1 +------------- + +* Improved `Read` instance. Now handles `"1.2e3"` and `reads` only returns a single parse. + +* Corrected documentation. + +* Added `Enum` instance. + +* `decimalConvert` now returns a Maybe value. The old version has been renamed +to "unsafeDecimalConvert. + +Version 0.5.1 +------------- + +* Bankers' Rounding implemented in "roundTo". This rounds values ending in "5" to +the nearest even number, in line with the behaviour of "Prelude.round". This +is potentially a breaking change for software that depends on the old +behavior, so the minor version number has been bumped. + +* Added a `stack.yaml` file. + +* Corrected documentation. + +* `Read` instance now handles leading spaces properly. + +* Fixed compiler warnings in test suite. + +* Added `roundTo'` which allows for `truncate`, `floor` and `ceiling` behaviour when rounding. diff --git a/src/Data/Decimal.hs b/src/Data/Decimal.hs --- a/src/Data/Decimal.hs +++ b/src/Data/Decimal.hs @@ -3,37 +3,52 @@ -- | Decimal numbers are represented as @m*10^(-e)@ where -- @m@ and @e@ are integers. The exponent @e@ is an unsigned Word8. Hence -- the smallest value that can be represented is @10^-255@. --- --- Unary arithmetic results have the exponent of the argument. Binary --- arithmetic results have an exponent equal to the maximum of the exponents --- of the arguments. --- --- Decimal numbers are defined as instances of @Real@. This means that --- conventional division is not defined. Instead the functions @divide@ and --- @allocate@ will split a decimal amount into lists of results. These --- results are guaranteed to sum to the original number. This is a useful --- property when doing financial arithmetic. --- +-- +-- Unary arithmetic results have the exponent of the argument. +-- Addition and subtraction results have an exponent equal to the +-- maximum of the exponents of the arguments. Other operators have +-- exponents sufficient to show the exact result, up to a limit of +-- 255: +-- +-- > 0.15 * 0.15 :: Decimal = 0.0225 +-- > (1/3) :: Decimal = 0.33333333333333... +-- > decimalPlaces (1/3) = 255 +-- +-- While @(/)@ is defined, you don't normally want to use it. Instead +-- The functions "divide" and "allocate" will split a decimal amount +-- into lists of results which are guaranteed to sum to the original +-- number. This is a useful property when doing financial arithmetic. +-- -- The arithmetic on mantissas is always done using @Integer@, regardless of --- the type of @DecimalRaw@ being manipulated. In practice it is recommended --- that @Decimal@ be used, with other types being used only where necessary --- (e.g. to conform to a network protocol). +-- the type of @DecimalRaw@ being manipulated. In practice it is strongly +-- recommended that @Decimal@ be used, with other types being used only where +-- necessary (e.g. to conform to a network protocol). For instance +-- @(1/3) :: DecimalRaw Int@ does not give the right answer. +-- +-- Care must be taken with literal values of type Decimal. As per the Haskell +-- Report, the literal @10.00@ will be converted into @fromRational 10.00@, which +-- in a @Decimal@ context will be converted into @10@ with zero decimal places. +-- Likewise @10.10@ will be converted into @10.1@ with one decimal place. If +-- you mean @10.00@ with 2 decimal places then you have to write @roundTo 2 10@. + module Data.Decimal ( -- ** Decimal Values DecimalRaw (..), Decimal, realFracToDecimal, decimalConvert, + unsafeDecimalConvert, roundTo, + roundTo', (*.), divide, allocate, eitherFromRational, - normalizeDecimal, + normalizeDecimal ) where -import Control.Monad.Instances () + import Control.DeepSeq import Data.Char import Data.Ratio @@ -44,56 +59,84 @@ -- | Raw decimal arithmetic type constructor. A decimal value consists of an -- integer mantissa and a negative exponent which is interpreted as the number -- of decimal places. The value stored in a @Decimal d@ is therefore equal to: --- +-- -- > decimalMantissa d / (10 ^ decimalPlaces d) --- +-- -- The "Show" instance will add trailing zeros, so @show $ Decimal 3 1500@ -- will return \"1.500\". Conversely the "Read" instance will use the decimal -- places to determine the precision. --- --- Arithmetic and comparision operators convert their arguments to the --- greater of the two precisions, and return a result of that precision. --- Regardless of the type of the arguments, all mantissa arithmetic is done --- using @Integer@ types, so application developers do not need to worry about --- overflow in the internal algorithms. However the result of each operator --- will be converted to the mantissa type without checking for overflow. -data (Integral i) => DecimalRaw i = Decimal { - decimalPlaces :: ! Word8, - decimalMantissa :: ! i} +data DecimalRaw i = Decimal { + decimalPlaces :: !Word8, + decimalMantissa :: !i} deriving (Typeable) --- | Arbitrary precision decimal type. As a rule programs should do decimal --- arithmetic with this type and only convert to other instances of --- "DecimalRaw" where required by an external interface. --- +-- | Arbitrary precision decimal type. Programs should do decimal +-- arithmetic with this type and only convert to other instances of +-- "DecimalRaw" where required by an external interface. This will avoid +-- issues with integer overflows. +-- -- Using this type is also faster because it avoids repeated conversions -- to and from @Integer@. type Decimal = DecimalRaw Integer -instance (Integral i, NFData i) => NFData (DecimalRaw i) where +instance (NFData i) => NFData (DecimalRaw i) where rnf (Decimal _ i) = rnf i --- | Convert a real fractional value into a Decimal of the appropriate +instance (Integral i) => Enum (DecimalRaw i) where + succ x = x + 1 + pred x = x - 1 + toEnum = fromIntegral + fromEnum = fromIntegral . decimalMantissa . roundTo 0 + enumFrom = iterate (+1) + enumFromThen x1 x2 = let dx = x2 - x1 in iterate (+dx) x1 + enumFromTo x1 x2 = takeWhile (<= x2) $ iterate (+1) x1 + enumFromThenTo x1 x2 x3 = takeWhile (<= x3) $ enumFromThen x1 x2 + + +-- | Convert a real fractional value into a Decimal of the appropriate -- precision. realFracToDecimal :: (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i realFracToDecimal e r = Decimal e $ round (r * (10^e)) --- Internal function to divide and return the nearest integer. +-- Internal function to divide and return the nearest integer. Implements Bankers' Rounding in +-- which 0.5 is rounded to the nearest even value. This follows the practice of "Prelude.round". divRound :: (Integral a) => a -> a -> a -divRound n1 n2 = if abs r > abs (n2 `quot` 2) then n + signum n else n - where (n, r) = n1 `quotRem` n2 +divRound n1 n2 = n + bankers + where + (n, r) = n1 `quotRem` n2 + bankers = case compare (abs r * 2) (abs n2) of + LT -> 0 + GT -> signum n1 + EQ -> if odd n then signum n1 else 0 -- | Convert a @DecimalRaw@ from one base representation to another. Does --- not check for overflow in the new representation. -decimalConvert :: (Integral a, Integral b) => DecimalRaw a -> DecimalRaw b -decimalConvert (Decimal e n) = Decimal e $ fromIntegral n +-- not check for overflow in the new representation. Only use after +-- using "roundTo" to put an upper value on the exponent, or to convert +-- to a larger representation. +unsafeDecimalConvert :: (Integral a, Integral b) => DecimalRaw a -> DecimalRaw b +unsafeDecimalConvert (Decimal e n) = Decimal e $ fromIntegral n +-- | Convert a @DecimalRaw@ from one base to another. Returns @Nothing@ if +-- this would cause arithmetic overflow. +decimalConvert :: (Integral a, Integral b, Bounded b) => + DecimalRaw a -> Maybe (DecimalRaw b) +decimalConvert (Decimal e n) = + let n1 :: Integer + n1 = fromIntegral n + n2 = fromIntegral n -- Of type b. + ub = fromIntegral $ max maxBound n2 -- Can't say "maxBound :: b", so do this instead. + lb = fromIntegral $ min minBound n2 + in if lb <= n1 && n1 <= ub then Just $ Decimal e n2 else Nothing + + -- | Round a @DecimalRaw@ to a specified number of decimal places. -roundTo :: (Integral i) => Word8 -> DecimalRaw i -> DecimalRaw Integer +-- If the value ends in @5@ then it is rounded to the nearest even value (Banker's Rounding) +roundTo :: (Integral i) => Word8 -> DecimalRaw i -> DecimalRaw i +roundTo d (Decimal _ 0) = Decimal d 0 roundTo d (Decimal e n) = Decimal d $ fromIntegral n1 where n1 = case compare d e of @@ -103,20 +146,37 @@ divisor = 10 ^ (e-d) multiplier = 10 ^ (d-e) +-- | Round a @DecimalRaw@ to a specified number of decimal places using the specified +-- rounding function. Typically this will be one of @floor@, @ceiling@, @truncate@ or @round@. +-- Note that @roundTo == roundTo\' round@ +roundTo' :: (Integral i) => (Rational -> i) -> Word8 -> DecimalRaw i -> DecimalRaw i +roundTo' _ d (Decimal _ 0) = Decimal d 0 +roundTo' f d (Decimal e n) = Decimal d $ f n1 + where + divisor = 10 ^ (e-d) + multiplier = 10 ^ (d-e) + n1 = case compare d e of + LT -> toRational n / divisor + EQ -> toRational n + GT -> toRational n * multiplier -- Round the two DecimalRaw values to the largest exponent. -roundMax :: (Integral i) => - DecimalRaw i -> DecimalRaw i -> (Word8, Integer, Integer) -roundMax d1@(Decimal e1 _) d2@(Decimal e2 _) = (e, n1, n2) +roundMax :: (Integral i) => DecimalRaw i -> DecimalRaw i -> (Word8, i, i) +roundMax (Decimal _ 0) (Decimal _ 0) = (0,0,0) +roundMax (Decimal e1 n1) (Decimal _ 0) = (e1,n1,0) +roundMax (Decimal _ 0) (Decimal e2 n2) = (e2,0,n2) +roundMax d1@(Decimal e1 n1) d2@(Decimal e2 n2) + | e1 == e2 = (e1, n1, n2) + | otherwise = (e, n1', n2') where e = max e1 e2 - (Decimal _ n1) = roundTo e d1 - (Decimal _ n2) = roundTo e d2 + (Decimal _ n1') = roundTo e d1 + (Decimal _ n2') = roundTo e d2 instance (Integral i, Show i) => Show (DecimalRaw i) where showsPrec _ (Decimal e n) - | e == 0 = (concat [signStr, strN] ++) + | e == 0 = ((signStr ++ strN) ++) | otherwise = (concat [signStr, intPart, ".", fracPart] ++) where strN = show $ abs n @@ -126,16 +186,35 @@ (intPart, fracPart) = splitAt (max 1 (len - fromIntegral e)) padded instance (Integral i, Read i) => Read (DecimalRaw i) where - readsPrec _ = - readP_to_S $ do - (intPart, _) <- gather $ do - optional $ char '-' - munch1 isDigit - fractPart <- option "" $ do + readsPrec _ = readP_to_S readDecimalP + + +-- | Parse a Decimal value. Used for the Read instance. +readDecimalP :: (Integral i, Read i) => ReadP (DecimalRaw i) +readDecimalP = do + skipSpaces + s1 <- myOpt '+' $ char '-' +++ char '+' + intPart <- munch1 isDigit + fractPart <- myOpt "" $ do _ <- char '.' munch1 isDigit - return $ Decimal (fromIntegral $ length fractPart) $ read $ - intPart ++ fractPart + expPart <- myOpt 0 $ do + _ <- char 'e' +++ char 'E' + s2 <- myOpt '+' $ char '-' +++ char '+' + fmap (applySign s2 . strToInt) $ munch1 isDigit + let n = applySign s1 $ strToInt $ intPart ++ fractPart + e = length fractPart - expPart + if e < 0 + then return $ Decimal 0 $ n * 10 ^ negate e + else if e < 256 + then return $ Decimal (fromIntegral e) n + else pfail + where + strToInt :: (Integral n) => String -> n + strToInt = foldl (\t v -> 10 * t + v) 0 . map (fromIntegral . subtract (ord '0') . ord) + applySign '-' v = negate v + applySign _ v = v + myOpt d p = p <++ return d instance (Integral i) => Eq (DecimalRaw i) where @@ -147,12 +226,17 @@ instance (Integral i) => Num (DecimalRaw i) where + (Decimal _ 0) + d = d + d + (Decimal _ 0) = d d1 + d2 = Decimal e $ fromIntegral (n1 + n2) where (e, n1, n2) = roundMax d1 d2 + (Decimal _ 0) - (Decimal e n) = Decimal e (-n) + d - (Decimal _ 0) = d d1 - d2 = Decimal e $ fromIntegral (n1 - n2) where (e, n1, n2) = roundMax d1 d2 - d1 * d2 = normalizeDecimal $ realFracToDecimal maxBound $ (toRational d1) * (toRational d2) - + (Decimal _ 0) * _ = 0 + _ * (Decimal _ 0) = 0 + d1 * d2 = normalizeDecimal $ realFracToDecimal maxBound $ toRational d1 * toRational d2 abs (Decimal e n) = Decimal e $ abs n signum (Decimal _ n) = fromIntegral $ signum n fromInteger n = Decimal 0 $ fromIntegral n @@ -161,30 +245,34 @@ toRational (Decimal e n) = fromIntegral n % (10 ^ e) instance (Integral i) => Fractional (DecimalRaw i) where - fromRational r = normalizeDecimal $ realFracToDecimal maxBound r - a / b = fromRational $ (toRational a) / (toRational b) + fromRational r = + let + v :: Decimal + v = normalizeDecimal $ realFracToDecimal maxBound r + in unsafeDecimalConvert v + a / b = fromRational $ toRational a / toRational b instance (Integral i) => RealFrac (DecimalRaw i) where properFraction a = (rnd, fromRational rep) where (rnd, rep) = properFraction $ toRational a - - + + -- | Divide a @DecimalRaw@ value into one or more portions. The portions -- will be approximately equal, and the sum of the portions is guaranteed to -- be the original value. --- +-- -- The portions are represented as a list of pairs. The first part of each -- pair is the number of portions, and the second part is the portion value. -- Hence 10 dollars divided 3 ways will produce @[(2, 3.33), (1, 3.34)]@. -divide :: (Integral i) => DecimalRaw i -> Int -> [(Int, DecimalRaw i)] -divide (Decimal e n) d - | d > 0 = +divide :: Decimal -> Int -> [(Int, Decimal)] +divide (Decimal e n) d + | d > 0 = case n `divMod` fromIntegral d of - (result, 0) -> [(fromIntegral d, Decimal e result)] - (result, r) -> [(fromIntegral d - fromIntegral r, - Decimal e result), + (result, 0) -> [(d, Decimal e result)] + (result, r) -> [(d - fromIntegral r, + Decimal e result), (fromIntegral r, Decimal e (result+1))] | otherwise = error "Data.Decimal.divide: Divisor must be > 0." @@ -192,25 +280,24 @@ -- | Allocate a @DecimalRaw@ value proportionately with the values in a list. -- The allocated portions are guaranteed to add up to the original value. --- --- Some of the allocations may be zero or negative, but the sum of the list +-- +-- Some of the allocations may be zero or negative, but the sum of the list -- must not be zero. The allocation is intended to be as close as possible -- to the following: --- +-- -- > let result = allocate d parts -- > in all (== d / sum parts) $ zipWith (/) result parts -allocate :: (Integral i) => DecimalRaw i -> [Integer] -> [DecimalRaw i] +allocate :: Decimal -> [Integer] -> [Decimal] allocate (Decimal e n) ps - | total == 0 = + | total == 0 = error "Data.Decimal.allocate: allocation list must not sum to zero." | otherwise = map (Decimal e) $ zipWith (-) ts (tail ts) where ts = map fst $ scanl nxt (n, total) ps - nxt (n1, t1) p1 = (n1 - (n1 * fromIntegral p1) `zdiv` t1, - t1 - fromIntegral p1) + nxt (n1, t1) p1 = (n1 - (n1 * p1) `zdiv` t1, t1 - p1) zdiv 0 0 = 0 zdiv x y = x `divRound` y - total = fromIntegral $ sum ps + total = sum ps -- | Multiply a @DecimalRaw@ by a @RealFrac@ value. @@ -246,12 +333,12 @@ (f5, done) = factorN 5 rest e = max f2 f5 m = num * ((10^e) `div` den) - we = if e > (fromIntegral (maxBound :: Word8)) -- FIXME: will fail if DecimalRaw changed + we = if e > fromIntegral (maxBound :: Word8) then Left $ show e ++ " is too big ten power to represent as Decimal" else Right $ fromIntegral e --- | Reduce the exponent of the decimal numer to the minimal posible value -normalizeDecimal :: (Integral i) => (DecimalRaw i) -> (DecimalRaw i) +-- | Reduce the exponent of the decimal number to the minimal possible value +normalizeDecimal :: (Integral i) => DecimalRaw i -> DecimalRaw i normalizeDecimal r = case eitherFromRational $ toRational r of Right x -> x - Left e -> error $ "Imposible happened: " ++ e + Left e -> error $ "Impossible happened: " ++ e diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -4,42 +4,50 @@ import Data.Ratio import Data.Word import Test.HUnit -import Control.Applicative import Test.QuickCheck -import qualified Test.QuickCheck.Property as P import Test.Framework as TF (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 (testProperty) -instance (Integral i, Arbitrary i) => Arbitrary (DecimalRaw i) where - arbitrary = Decimal <$> arbitrary <*> arbitrary - -- arbitrary = do +-- | Newtype introduced to avoid orphan instance. +newtype TestDecRaw i = Test (DecimalRaw i) deriving Show + +type TestDec = TestDecRaw Integer + +instance (Integral i, Arbitrary i) => Arbitrary (TestDecRaw i) where + arbitrary = Test <$> (Decimal <$> arbitrary <*> arbitrary) + -- arbitrary = do -- e <- sized (\n -> resize (n `div` 10) arbitrary) :: Gen Int -- m <- sized (\n -> resize (n * 10) arbitrary) -- return $ Decimal (fromIntegral $ abs e) m - -instance (Integral i, Arbitrary i) => CoArbitrary (DecimalRaw i) where - coarbitrary (Decimal e m) gen = variant (v:: Integer) gen + +instance (Integral i, Arbitrary i) => CoArbitrary (TestDecRaw i) where + coarbitrary (Test (Decimal e m)) = variant (v:: Integer) where v = fromIntegral e + fromIntegral m - + -- | "read" is the inverse of "show". --- +-- -- > read (show n) == n -prop_readShow :: Decimal -> Bool -prop_readShow d = (read (show d)) == d +prop_readShow :: TestDec -> Bool +prop_readShow (Test d) = read (show d) == d + +-- | "read" can handle leading spaces. +prop_readShow1 :: TestDec -> Bool +prop_readShow1 (Test d) = read (" " ++ show d) == d + -- | Read and show preserve decimal places. --- +-- -- > decimalPlaces (read (show n)) == decimalPlaces n -prop_readShowPrecision :: Decimal -> Bool -prop_readShowPrecision d = decimalPlaces (read (show d) :: Decimal) +prop_readShowPrecision :: TestDec -> Bool +prop_readShowPrecision (Test d) = decimalPlaces (read (show d) :: Decimal) == decimalPlaces d -- | "fromInteger" definition. --- +-- -- > decimalPlaces (fromInteger n) == 0 && -- > decimalMantissa (fromInteger n) == n prop_fromIntegerZero :: Integer -> Bool @@ -48,16 +56,16 @@ -- | Increased precision does not affect equality. --- +-- -- > decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d -prop_increaseDecimals :: Decimal -> Property -prop_increaseDecimals d = +prop_increaseDecimals :: TestDec -> Property +prop_increaseDecimals (Test d) = decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d -- | Decreased precision can make two decimals equal, but it can never change -- their order. --- +-- -- > forAll d1, d2 :: Decimal -> legal beforeRound afterRound -- > where -- > beforeRound = compare d1 d2 @@ -65,8 +73,8 @@ -- > legal GT x = x `elem` [GT, EQ] -- > legal EQ x = x `elem` [EQ] -- > legal LT x = x `elem` [LT, EQ] -prop_decreaseDecimals :: Decimal -> Decimal -> Bool -prop_decreaseDecimals d1 d2 = legal beforeRound afterRound +prop_decreaseDecimals :: TestDec -> TestDec -> Bool +prop_decreaseDecimals (Test d1) (Test d2) = legal beforeRound afterRound where beforeRound = compare d1 d2 afterRound = compare (roundTo 0 d1) (roundTo 0 d2) @@ -74,101 +82,105 @@ legal EQ x = x `elem` [EQ] legal LT x = x `elem` [LT, EQ] +-- | @roundTo == roundTo' round@ +prop_roundTo :: TestDec -> Word8 -> Bool +prop_roundTo (Test d) e = roundTo' round e d == roundTo e d -- | > (x + y) - y == x -prop_inverseAdd :: Decimal -> Decimal -> Bool -prop_inverseAdd x y = (x + y) - y == x +prop_inverseAdd :: TestDec -> TestDec -> Bool +prop_inverseAdd (Test x) (Test y) = (x + y) - y == x -- | Multiplication is repeated addition. --- +-- -- > forall d, NonNegative i : (sum $ replicate i d) == d * fromIntegral (max i 0) -prop_repeatedAdd :: Decimal -> Word8 -> Bool -prop_repeatedAdd d i = (sum $ replicate (fromIntegral i) d) == d * fromIntegral (max i 0) +prop_repeatedAdd :: TestDec -> Word8 -> Bool +prop_repeatedAdd (Test d) i = (sum $ replicate (fromIntegral i) d) == d * fromIntegral (max i 0) -- | Division produces the right number of parts. --- +-- -- > forall d, Positive i : (sum $ map fst $ divide d i) == i -prop_divisionParts :: Decimal -> Positive Int -> Property -prop_divisionParts d (Positive i) = i > 0 ==> (sum $ map fst $ divide d i) == i +prop_divisionParts :: TestDec -> Positive Int -> Property +prop_divisionParts (Test d) (Positive i) = i > 0 ==> (sum $ map fst $ divide d i) == i -- | Division doesn't drop any units. --- +-- -- > forall d, Positive i : (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d -prop_divisionUnits :: Decimal -> Positive Int -> Bool -prop_divisionUnits d (Positive i) = +prop_divisionUnits :: TestDec -> Positive Int -> Bool +prop_divisionUnits (Test d) (Positive i) = (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d -- | Allocate produces the right number of parts. --- +-- -- > sum ps /= 0 ==> length ps == length (allocate d ps) -prop_allocateParts :: Decimal -> [Integer] -> Property -prop_allocateParts d ps = +prop_allocateParts :: TestDec -> [Integer] -> Property +prop_allocateParts (Test d) ps = sum ps /= 0 ==> length ps == length (allocate d ps) -- | Allocate doesn't drop any units. --- +-- -- > sum ps /= 0 ==> sum (allocate d ps) == d -prop_allocateUnits :: Decimal -> [Integer] -> Property -prop_allocateUnits d ps = +prop_allocateUnits :: TestDec -> [Integer] -> Property +prop_allocateUnits (Test d) ps = sum ps /= 0 ==> sum (allocate d ps) == d -- | Absolute value definition --- --- > decimalPlaces a == decimalPlaces d && +-- +-- > decimalPlaces a == decimalPlaces d && -- > decimalMantissa a == abs (decimalMantissa d) -- > where a = abs d -prop_abs :: Decimal -> Bool -prop_abs d = decimalPlaces a == decimalPlaces d && - decimalMantissa a == abs (decimalMantissa d) +prop_abs :: TestDec -> Bool +prop_abs (Test d) = decimalPlaces a == decimalPlaces d && + decimalMantissa a == abs (decimalMantissa d) where a = abs d --- | Sign number defintion --- +-- | Sign number definition +-- -- > signum d == (fromInteger $ signum $ decimalMantissa d) -prop_signum :: Decimal -> Bool -prop_signum d = signum d == (fromInteger $ signum $ decimalMantissa d) +prop_signum :: TestDec -> Bool +prop_signum (Test d) = signum d == (fromInteger $ signum $ decimalMantissa d) -- | The addition is valid - -prop_sumValid :: Decimal -> Decimal -> Property -prop_sumValid a b = (decimalPlaces a < maxBound && decimalPlaces b < maxBound) ==> + +prop_sumValid :: TestDec -> TestDec -> Property +prop_sumValid (Test a) (Test b) = (decimalPlaces a < maxBound && decimalPlaces b < maxBound) ==> (toRational (a + b) == (toRational a) + (toRational b)) -prop_mulValid :: Decimal -> Decimal -> Property -prop_mulValid a b = ((ad + bd) < fromIntegral (maxBound :: Word8)) ==> +prop_mulValid :: TestDec -> TestDec -> Property +prop_mulValid (Test a) (Test b) = ((ad + bd) < fromIntegral (maxBound :: Word8)) ==> (toRational (a * b) == (toRational a) * (toRational b)) where - ad :: Integer + ad, bd :: Integer ad = fromIntegral $ decimalPlaces a bd = fromIntegral $ decimalPlaces b -prop_eitherFromRational :: Decimal -> Bool -prop_eitherFromRational d = (Right d) == (eitherFromRational $ toRational d) +prop_eitherFromRational :: TestDec -> Bool +prop_eitherFromRational (Test d) = (Right d) == (eitherFromRational $ toRational d) -prop_normalizeDecimal :: Decimal -> Bool -prop_normalizeDecimal d = d == (normalizeDecimal d) +prop_normalizeDecimal :: TestDec -> Bool +prop_normalizeDecimal (Test d) = d == (normalizeDecimal d) -- | Division is the inverted multiplication -prop_divisionMultiplication :: Decimal -> Decimal -> Property -prop_divisionMultiplication a b = ((ad + bd) < fromIntegral (maxBound :: Word8) && a /= 0 && b /= 0) ==> - (c / a == b) .&&. (c / b == a) +prop_divisionMultiplication :: TestDec -> TestDec -> Property +prop_divisionMultiplication (Test a) (Test b) = + ((ad + bd) < fromIntegral (maxBound :: Word8) && a /= 0 && b /= 0) ==> + (c / a == b) .&&. (c / b == a) where ad :: Integer ad = fromIntegral $ decimalPlaces a bd = fromIntegral $ decimalPlaces b c = a * b -prop_fromRational :: Decimal -> Bool -prop_fromRational a = a == (fromRational $ toRational a) +prop_fromRational :: TestDec -> Bool +prop_fromRational (Test a) = a == (fromRational $ toRational a) -prop_properFraction :: Decimal -> Bool -prop_properFraction a = a == (fromIntegral b + d) +prop_properFraction :: TestDec -> Bool +prop_properFraction (Test a) = a == (fromIntegral b + d) where b :: Integer (b, d) = properFraction a @@ -192,10 +204,12 @@ tests = [ testGroup "QuickCheck Data.Decimal" [ testProperty "readShow" prop_readShow, + testProperty "readShow1" prop_readShow1, testProperty "readShowPrecision" prop_readShowPrecision, - testProperty "fromIntegerZero" prop_fromIntegerZero, + testProperty "fromIntegerZero" prop_fromIntegerZero, testProperty "increaseDecimals" prop_increaseDecimals, testProperty "decreaseDecimals" prop_decreaseDecimals, + testProperty "roundTo" prop_roundTo, testProperty "inverseAdd" prop_inverseAdd, testProperty "repeatedAdd" prop_repeatedAdd, testProperty "divisionParts" prop_divisionParts, @@ -218,8 +232,19 @@ testCase "100*pi to 2dp" (dec 2 31416 @=? realFracToDecimal 2 (100 * piD)), testCase "1.0 * pi" (dec 1 31 @=? dec 1 10 *. piD), testCase "1.23 * pi" (dec 2 386 @=? dec 2 123 *. piD), - testCase "Decimal to DecimalRaw Int" - (decimalConvert (dec 2 123) @=? dec1 2 123), - testCase "1.234 to rational" (1234 % 1000 @=? (toRational (dec 3 1234))) + testCase "Decimal to DecimalRaw Int" + (decimalConvert (dec 2 123) @=? Just (dec1 2 123)), + testCase "decimalConvert overflow prevention" + (decimalConvert (1/3 :: Decimal) @=? + (Nothing :: Maybe (DecimalRaw Int))), + testCase "1.234 to rational" (1234 % 1000 @=? toRational (dec 3 1234)), + testCase "fromRational (1%10) for DecimalRaw Int" -- Fixed bug #3 + (let v :: DecimalRaw Int + v = fromRational (1%10) + in toRational v @=? 1%10), + testCase "Bankers rounding up" + (roundTo 1 (dec 2 115) @=? dec 1 12), + testCase "Bankers rounding down" + (roundTo 1 (dec 2 125) @=? dec 1 12) ] ]