Decimal-0.5.2/src/0000755000000000000000000000000013223162745012036 5ustar0000000000000000Decimal-0.5.2/src/Data/0000755000000000000000000000000014023351220012672 5ustar0000000000000000Decimal-0.5.2/tests/0000755000000000000000000000000013223162745012411 5ustar0000000000000000Decimal-0.5.2/src/Data/Decimal.hs0000644000000000000000000003200014023351220014557 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | 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. -- 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 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 ) where import Control.DeepSeq import Data.Char import Data.Ratio import Data.Word import Data.Typeable import Text.ParserCombinators.ReadP -- | 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. data DecimalRaw i = Decimal { decimalPlaces :: !Word8, decimalMantissa :: !i} deriving (Typeable) -- | 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 (NFData i) => NFData (DecimalRaw i) where rnf (Decimal _ i) = rnf i 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. 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 = 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. 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. -- 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 LT -> n `divRound` divisor EQ -> n GT -> n * multiplier 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, 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 instance (Integral i, Show i) => Show (DecimalRaw i) where showsPrec _ (Decimal e n) | e == 0 = ((signStr ++ strN) ++) | otherwise = (concat [signStr, intPart, ".", fracPart] ++) where strN = show $ abs n signStr = if n < 0 then "-" else "" len = length strN padded = replicate (fromIntegral e + 1 - len) '0' ++ strN (intPart, fracPart) = splitAt (max 1 (len - fromIntegral e)) padded instance (Integral i, Read i) => Read (DecimalRaw i) where 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 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 d1 == d2 = n1 == n2 where (_, n1, n2) = roundMax d1 d2 instance (Integral i) => Ord (DecimalRaw i) where compare d1 d2 = compare n1 n2 where (_, n1, n2) = roundMax d1 d2 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 (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 instance (Integral i) => Real (DecimalRaw i) where toRational (Decimal e n) = fromIntegral n % (10 ^ e) instance (Integral i) => Fractional (DecimalRaw i) where 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 :: Decimal -> Int -> [(Int, Decimal)] divide (Decimal e n) d | d > 0 = case n `divMod` fromIntegral d of (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." -- | 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 -- 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 :: Decimal -> [Integer] -> [Decimal] allocate (Decimal e n) ps | 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 * p1) `zdiv` t1, t1 - p1) zdiv 0 0 = 0 zdiv x y = x `divRound` y total = sum ps -- | Multiply a @DecimalRaw@ by a @RealFrac@ value. (*.) :: (Integral i, RealFrac r) => DecimalRaw i -> r -> DecimalRaw i (Decimal e m) *. d = Decimal e $ round $ fromIntegral m * d -- | Count the divisors, i.e. the count of 2 divisors in 18 is 1 because 18 = 2 * 3 * 3 factorN :: (Integral a) => a -- ^ Denominator base -> a -- ^ dividing value -> (a, a) -- ^ The count of divisors and the result of division factorN d val = factorN' val 0 where factorN' 1 acc = (acc, 1) factorN' v acc = if md == 0 then factorN' vd (acc + 1) else (acc, v) where (vd, md) = v `divMod` d -- | Try to convert Rational to Decimal with absolute precision -- return string with fail description if not converted eitherFromRational :: (Integral i) => Rational -> Either String (DecimalRaw i) eitherFromRational r = if done == 1 then do wres <- we return $ Decimal wres (fromIntegral m) else Left $ show r ++ " has no decimal denominator" where den = denominator r num = numerator r (f2, rest) = factorN 2 den (f5, done) = factorN 5 rest e = max f2 f5 m = num * ((10^e) `div` den) 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 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 $ "Impossible happened: " ++ e Decimal-0.5.2/tests/Main.hs0000644000000000000000000002273513223162745013642 0ustar0000000000000000module Main where import Data.Decimal import Data.Ratio import Data.Word import Test.HUnit import Test.QuickCheck import Test.Framework as TF (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 (testProperty) -- | 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 (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 :: 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 :: 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 prop_fromIntegerZero n = decimalPlaces (fromInteger n :: Decimal) == 0 && decimalMantissa (fromInteger n :: Decimal) == n -- | Increased precision does not affect equality. -- -- > decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == 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 -- > afterRound = compare (roundTo 0 d1) (roundTo 0 d2) -- > legal GT x = x `elem` [GT, EQ] -- > legal EQ x = x `elem` [EQ] -- > legal LT x = x `elem` [LT, EQ] 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) legal GT x = x `elem` [GT, EQ] 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: TestDec -> [Integer] -> Property prop_allocateUnits (Test d) ps = sum ps /= 0 ==> sum (allocate d ps) == d -- | Absolute value definition -- -- > decimalPlaces a == decimalPlaces d && -- > decimalMantissa a == abs (decimalMantissa d) -- > where a = abs d prop_abs :: TestDec -> Bool prop_abs (Test d) = decimalPlaces a == decimalPlaces d && decimalMantissa a == abs (decimalMantissa d) where a = abs d -- | Sign number definition -- -- > 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 :: TestDec -> TestDec -> Property prop_sumValid (Test a) (Test b) = (decimalPlaces a < maxBound && decimalPlaces b < maxBound) ==> (toRational (a + b) == (toRational a) + (toRational b)) 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, bd :: Integer ad = fromIntegral $ decimalPlaces a bd = fromIntegral $ decimalPlaces b prop_eitherFromRational :: TestDec -> Bool prop_eitherFromRational (Test d) = (Right d) == (eitherFromRational $ toRational d) prop_normalizeDecimal :: TestDec -> Bool prop_normalizeDecimal (Test d) = d == (normalizeDecimal d) -- | Division is the inverted multiplication 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 :: TestDec -> Bool prop_fromRational (Test a) = a == (fromRational $ toRational a) prop_properFraction :: TestDec -> Bool prop_properFraction (Test a) = a == (fromIntegral b + d) where b :: Integer (b, d) = properFraction a main :: IO () main = defaultMain tests -- Monomorphic variations on polymorphic themes to avoid type default warnings. dec :: Word8 -> Integer -> Decimal dec = Decimal dec1 :: Word8 -> Int -> DecimalRaw Int dec1 = Decimal piD :: Double piD = pi tests :: [TF.Test] tests = [ testGroup "QuickCheck Data.Decimal" [ testProperty "readShow" prop_readShow, testProperty "readShow1" prop_readShow1, testProperty "readShowPrecision" prop_readShowPrecision, 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, testProperty "divisionUnits" prop_divisionUnits, testProperty "allocateParts" prop_allocateParts, testProperty "allocateUnits" prop_allocateUnits, testProperty "abs" prop_abs, testProperty "signum" prop_signum, testProperty "sumvalid" prop_sumValid, testProperty "mulValid" prop_mulValid, testProperty "eitherFromRational" prop_eitherFromRational, testProperty "normalizeDecimal" prop_normalizeDecimal, testProperty "divisionMultiplication" prop_divisionMultiplication, testProperty "fromRational" prop_fromRational, testProperty "properFraction" prop_properFraction ], testGroup "Point tests Data.Decimal" [ testCase "pi to 3dp" (dec 3 3142 @=? realFracToDecimal 3 piD), testCase "pi to 2dp" (dec 2 314 @=? realFracToDecimal 2 piD), 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) @=? 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) ] ] Decimal-0.5.2/LICENSE.txt0000644000000000000000000000276613223162745013105 0ustar0000000000000000Copyright (c) 2008, Paul Johnson All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the Decimal project nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Decimal-0.5.2/README.md0000644000000000000000000000207613223173206012525 0ustar0000000000000000Haskell-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 Decimal-0.5.2/changelog.md0000644000000000000000000000274613223173204013521 0ustar0000000000000000Version 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. Decimal-0.5.2/Setup.hs0000644000000000000000000000010213223162745012674 0ustar0000000000000000module Main where import Distribution.Simple main = defaultMain Decimal-0.5.2/Decimal.cabal0000644000000000000000000000325714023354444013576 0ustar0000000000000000Name: Decimal Version: 0.5.2 License: BSD3 License-file: LICENSE.txt Copyright: Paul Johnson, 2013, 2018, 2021. Author: Paul Johnson Maintainer: paul@cogito.org.uk Stability: beta Category: Math 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. 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: base >= 4 && < 5, deepseq hs-source-dirs: src if impl(ghc >= 7.0.0) default-language: Haskell2010 ghc-options: -Wall exposed-modules: Data.Decimal test-suite Main type: exitcode-stdio-1.0 x-uses-tf: true build-depends: base >= 4 && < 5, HUnit >= 1.2 && < 2, QuickCheck >= 2.4, test-framework >= 0.4.1, test-framework-quickcheck2, test-framework-hunit, deepseq ghc-options: -Wall -rtsopts hs-source-dirs: src, src/Data, tests -- The following lines trigger a bug in Hackage. Uncommment for compilation on GHC 6. -- if impl(ghc >= 7.0.0) -- default-language: Haskell2010 default-language: Haskell2010 main-is: Main.hs other-modules: Data.Decimal