Decimal-0.4.2/0000755000000000000000000000000012411753634011247 5ustar0000000000000000Decimal-0.4.2/LICENSE.txt0000644000000000000000000000276612411753634013105 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.4.2/README.txt0000644000000000000000000000404612411753634012751 0ustar0000000000000000Variable 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 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.4.2 ------------- Removed spurious "Integer" type context. Decimal-0.4.2/Setup.hs0000644000000000000000000000010212411753634012674 0ustar0000000000000000module Main where import Distribution.Simple main = defaultMain Decimal-0.4.2/Decimal.cabal0000644000000000000000000000314612411753634013575 0ustar0000000000000000Name: Decimal Version: 0.4.2 License: BSD3 License-file: LICENSE.txt Copyright: Paul Johnson, 2013 Author: Paul Johnson Maintainer: paul@cogito.org.uk Stability: beta Category: Math Cabal-version: >=1.10 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.6.3 homepage: https://github.com/PaulJohnson/Haskell-Decimal 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 Decimal-0.4.2/tests/0000755000000000000000000000000012411753634012411 5ustar0000000000000000Decimal-0.4.2/tests/Main.hs0000644000000000000000000002106112411753634013631 0ustar0000000000000000module Main where import Data.Decimal import Data.Ratio import Data.Word import Test.HUnit import Control.Applicative import Test.QuickCheck 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 -- 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) = 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 -- | Read and show preserve decimal places. -- -- > decimalPlaces (read (show n)) == decimalPlaces n prop_readShowPrecision :: Decimal -> Bool prop_readShowPrecision 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 :: Decimal -> Property prop_increaseDecimals 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 :: Decimal -> Decimal -> Bool prop_decreaseDecimals d1 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] -- | > (x + y) - y == x prop_inverseAdd :: Decimal -> Decimal -> Bool prop_inverseAdd x 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) -- | 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 -- | 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) = (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 = 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 = 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 :: Decimal -> Bool prop_abs d = decimalPlaces a == decimalPlaces d && decimalMantissa a == abs (decimalMantissa d) where a = abs d -- | Sign number defintion -- -- > signum d == (fromInteger $ signum $ decimalMantissa d) prop_signum :: Decimal -> Bool prop_signum 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) ==> (toRational (a + b) == (toRational a) + (toRational b)) prop_mulValid :: Decimal -> Decimal -> Property prop_mulValid a 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 :: Decimal -> Bool prop_eitherFromRational d = (Right d) == (eitherFromRational $ toRational d) prop_normalizeDecimal :: Decimal -> Bool prop_normalizeDecimal 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) 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_properFraction :: Decimal -> Bool prop_properFraction 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 "readShowPrecision" prop_readShowPrecision, testProperty "fromIntegerZero" prop_fromIntegerZero, testProperty "increaseDecimals" prop_increaseDecimals, testProperty "decreaseDecimals" prop_decreaseDecimals, 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) @=? (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) ] ] Decimal-0.4.2/src/0000755000000000000000000000000012411753634012036 5ustar0000000000000000Decimal-0.4.2/src/Data/0000755000000000000000000000000012411753634012707 5ustar0000000000000000Decimal-0.4.2/src/Data/Decimal.hs0000644000000000000000000002726312411753634014613 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. module Data.Decimal ( -- ** Decimal Values DecimalRaw (..), Decimal, realFracToDecimal, decimalConvert, unsafeDecimalConvert, roundTo, (*.), divide, allocate, eitherFromRational, normalizeDecimal ) where import Control.Monad.Instances () 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. -- -- 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 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. -- -- 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. Rounds 0.5 away from zero. divRound :: (Integral a) => a -> a -> a divRound n1 n2 = if abs r * 2 >= abs n2 then n + signum n1 else n where (n, r) = n1 `quotRem` n2 -- | 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 away from zero. roundTo :: (Integral i) => Word8 -> DecimalRaw i -> DecimalRaw i 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 the two DecimalRaw values to the largest exponent. roundMax :: (Integral i) => DecimalRaw i -> DecimalRaw i -> (Word8, i, i) roundMax d1@(Decimal e1 _) d2@(Decimal e2 _) = (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 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 d1 + d2 = Decimal e $ fromIntegral (n1 + n2) where (e, n1, n2) = roundMax d1 d2 d1 - d2 = Decimal e $ fromIntegral (n1 - n2) where (e, n1, n2) = roundMax d1 d2 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