{-# 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 {
      forall i. DecimalRaw i -> Word8
decimalPlaces :: !Word8,
      forall i. DecimalRaw i -> i
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 :: DecimalRaw i -> ()
rnf (Decimal Word8
_ i
i) = i -> ()
forall a. NFData a => a -> ()
rnf i
i

instance (Integral i) => Enum (DecimalRaw i) where
   succ :: DecimalRaw i -> DecimalRaw i
succ DecimalRaw i
x = DecimalRaw i
x DecimalRaw i -> DecimalRaw i -> DecimalRaw i
forall a. Num a => a -> a -> a
+ DecimalRaw i
1
   pred :: DecimalRaw i -> DecimalRaw i
pred DecimalRaw i
x = DecimalRaw i
x DecimalRaw i -> DecimalRaw i -> DecimalRaw i
forall a. Num a => a -> a -> a
- DecimalRaw i
1
   toEnum :: Int -> DecimalRaw i
toEnum = Int -> DecimalRaw i
forall a b. (Integral a, Num b) => a -> b
fromIntegral
   fromEnum :: DecimalRaw i -> Int
fromEnum = i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> Int) -> (DecimalRaw i -> i) -> DecimalRaw i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecimalRaw i -> i
forall i. DecimalRaw i -> i
decimalMantissa (DecimalRaw i -> i)
-> (DecimalRaw i -> DecimalRaw i) -> DecimalRaw i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> DecimalRaw i -> DecimalRaw i
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
0
   enumFrom :: DecimalRaw i -> [DecimalRaw i]
enumFrom = (DecimalRaw i -> DecimalRaw i) -> DecimalRaw i -> [DecimalRaw i]
forall a. (a -> a) -> a -> [a]
iterate (DecimalRaw i -> DecimalRaw i -> DecimalRaw i
forall a. Num a => a -> a -> a
+DecimalRaw i
1)
   enumFromThen :: DecimalRaw i -> DecimalRaw i -> [DecimalRaw i]
enumFromThen DecimalRaw i
x1 DecimalRaw i
x2 = let dx :: DecimalRaw i
dx = DecimalRaw i
x2 DecimalRaw i -> DecimalRaw i -> DecimalRaw i
forall a. Num a => a -> a -> a
- DecimalRaw i
x1 in (DecimalRaw i -> DecimalRaw i) -> DecimalRaw i -> [DecimalRaw i]
forall a. (a -> a) -> a -> [a]
iterate (DecimalRaw i -> DecimalRaw i -> DecimalRaw i
forall a. Num a => a -> a -> a
+DecimalRaw i
dx) DecimalRaw i
x1
   enumFromTo :: DecimalRaw i -> DecimalRaw i -> [DecimalRaw i]
enumFromTo DecimalRaw i
x1 DecimalRaw i
x2 = (DecimalRaw i -> Bool) -> [DecimalRaw i] -> [DecimalRaw i]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (DecimalRaw i -> DecimalRaw i -> Bool
forall a. Ord a => a -> a -> Bool
<= DecimalRaw i
x2) ([DecimalRaw i] -> [DecimalRaw i])
-> [DecimalRaw i] -> [DecimalRaw i]
forall a b. (a -> b) -> a -> b
$ (DecimalRaw i -> DecimalRaw i) -> DecimalRaw i -> [DecimalRaw i]
forall a. (a -> a) -> a -> [a]
iterate (DecimalRaw i -> DecimalRaw i -> DecimalRaw i
forall a. Num a => a -> a -> a
+DecimalRaw i
1) DecimalRaw i
x1
   enumFromThenTo :: DecimalRaw i -> DecimalRaw i -> DecimalRaw i -> [DecimalRaw i]
enumFromThenTo DecimalRaw i
x1 DecimalRaw i
x2 DecimalRaw i
x3 = (DecimalRaw i -> Bool) -> [DecimalRaw i] -> [DecimalRaw i]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (DecimalRaw i -> DecimalRaw i -> Bool
forall a. Ord a => a -> a -> Bool
<= DecimalRaw i
x3) ([DecimalRaw i] -> [DecimalRaw i])
-> [DecimalRaw i] -> [DecimalRaw i]
forall a b. (a -> b) -> a -> b
$ DecimalRaw i -> DecimalRaw i -> [DecimalRaw i]
forall a. Enum a => a -> a -> [a]
enumFromThen DecimalRaw i
x1 DecimalRaw i
x2


-- | Convert a real fractional value into a Decimal of the appropriate
-- precision.
realFracToDecimal :: (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal :: forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal Word8
e r
r = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ r -> i
forall b. Integral b => r -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (r
r r -> r -> r
forall a. Num a => a -> a -> a
* (r
10r -> Word8 -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Word8
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 :: forall a. Integral a => a -> a -> a
divRound a
n1 a
n2 = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
bankers
    where
      (a
n, a
r) = a
n1 a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
n2
      bankers :: a
bankers = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> a
forall a. Num a => a -> a
abs a
r a -> a -> a
forall a. Num a => a -> a -> a
* a
2) (a -> a
forall a. Num a => a -> a
abs a
n2) of
         Ordering
LT -> a
0
         Ordering
GT -> a -> a
forall a. Num a => a -> a
signum a
n1
         Ordering
EQ -> if a -> Bool
forall a. Integral a => a -> Bool
odd a
n then a -> a
forall a. Num a => a -> a
signum a
n1 else a
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 :: forall a b.
(Integral a, Integral b) =>
DecimalRaw a -> DecimalRaw b
unsafeDecimalConvert (Decimal Word8
e a
n) = Word8 -> b -> DecimalRaw b
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (b -> DecimalRaw b) -> b -> DecimalRaw b
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
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 :: forall a b.
(Integral a, Integral b, Bounded b) =>
DecimalRaw a -> Maybe (DecimalRaw b)
decimalConvert (Decimal Word8
e a
n) =
   let n1 :: Integer
       n1 :: Integer
n1 = a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
       n2 :: b
n2 = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n   -- Of type b.
       ub :: Integer
ub = b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> Integer) -> b -> Integer
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a. Ord a => a -> a -> a
max b
forall a. Bounded a => a
maxBound b
n2  -- Can't say "maxBound :: b", so do this instead.
       lb :: Integer
lb = b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> Integer) -> b -> Integer
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a. Ord a => a -> a -> a
min b
forall a. Bounded a => a
minBound b
n2
   in if Integer
lb Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n1 Bool -> Bool -> Bool
&& Integer
n1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
ub then DecimalRaw b -> Maybe (DecimalRaw b)
forall a. a -> Maybe a
Just (DecimalRaw b -> Maybe (DecimalRaw b))
-> DecimalRaw b -> Maybe (DecimalRaw b)
forall a b. (a -> b) -> a -> b
$ Word8 -> b -> DecimalRaw b
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e b
n2 else Maybe (DecimalRaw b)
forall a. Maybe a
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 :: forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
d (Decimal Word8
_ i
0) = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
d i
0
roundTo Word8
d (Decimal Word8
e i
n) = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
d (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ i -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n1
    where
      n1 :: i
n1 = case Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word8
d Word8
e of
             Ordering
LT -> i
n i -> i -> i
forall a. Integral a => a -> a -> a
`divRound` i
divisor
             Ordering
EQ -> i
n
             Ordering
GT -> i
n i -> i -> i
forall a. Num a => a -> a -> a
* i
multiplier
      divisor :: i
divisor = i
10 i -> Word8 -> i
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word8
eWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
d)
      multiplier :: i
multiplier = i
10 i -> Word8 -> i
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word8
dWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
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' :: forall i.
Integral i =>
(Rational -> i) -> Word8 -> DecimalRaw i -> DecimalRaw i
roundTo' Rational -> i
_ Word8
d (Decimal Word8
_  i
0) = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
d i
0
roundTo' Rational -> i
f Word8
d (Decimal Word8
e i
n) = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
d (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ Rational -> i
f Rational
n1
   where
      divisor :: Rational
divisor = Rational
10 Rational -> Word8 -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word8
eWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
d)
      multiplier :: Rational
multiplier = Rational
10 Rational -> Word8 -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word8
dWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
e)
      n1 :: Rational
n1 = case Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word8
d Word8
e of
         Ordering
LT -> i -> Rational
forall a. Real a => a -> Rational
toRational i
n Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
divisor
         Ordering
EQ -> i -> Rational
forall a. Real a => a -> Rational
toRational i
n
         Ordering
GT -> i -> Rational
forall a. Real a => a -> Rational
toRational i
n Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
multiplier

-- Round the two DecimalRaw values to the largest exponent.
roundMax :: (Integral i) => DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
roundMax :: forall i.
Integral i =>
DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
roundMax (Decimal Word8
_  i
0)   (Decimal Word8
_  i
0)  = (Word8
0,i
0,i
0)
roundMax (Decimal Word8
e1 i
n1)  (Decimal Word8
_  i
0)  = (Word8
e1,i
n1,i
0)
roundMax (Decimal Word8
_  i
0)   (Decimal Word8
e2 i
n2) = (Word8
e2,i
0,i
n2)
roundMax d1 :: DecimalRaw i
d1@(Decimal Word8
e1 i
n1) d2 :: DecimalRaw i
d2@(Decimal Word8
e2 i
n2)
  | Word8
e1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
e2  = (Word8
e1, i
n1, i
n2)
  | Bool
otherwise = (Word8
e, i
n1', i
n2')
    where
      e :: Word8
e = Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
e1 Word8
e2
      (Decimal Word8
_ i
n1') = Word8 -> DecimalRaw i -> DecimalRaw i
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
e DecimalRaw i
d1
      (Decimal Word8
_ i
n2') = Word8 -> DecimalRaw i -> DecimalRaw i
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
e DecimalRaw i
d2


instance (Integral i, Show i) => Show (DecimalRaw i) where
   showsPrec :: Int -> DecimalRaw i -> ShowS
showsPrec Int
_ (Decimal Word8
e i
n)
       | Word8
e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0     = ((String
signStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strN) String -> ShowS
forall a. [a] -> [a] -> [a]
++)
       | Bool
otherwise  = ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
signStr, String
intPart, String
".", String
fracPart] String -> ShowS
forall a. [a] -> [a] -> [a]
++)
       where
         strN :: String
strN = i -> String
forall a. Show a => a -> String
show (i -> String) -> i -> String
forall a b. (a -> b) -> a -> b
$ i -> i
forall a. Num a => a -> a
abs i
n
         signStr :: String
signStr = if i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0 then String
"-" else String
""
         len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
strN
         padded :: String
padded = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strN
         (String
intPart, String
fracPart) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
e)) String
padded

instance (Integral i, Read i) => Read (DecimalRaw i) where
    readsPrec :: Int -> ReadS (DecimalRaw i)
readsPrec Int
_ = ReadP (DecimalRaw i) -> ReadS (DecimalRaw i)
forall a. ReadP a -> ReadS a
readP_to_S ReadP (DecimalRaw i)
forall i. (Integral i, Read i) => ReadP (DecimalRaw i)
readDecimalP


-- | Parse a Decimal value. Used for the Read instance.
readDecimalP :: (Integral i, Read i) => ReadP (DecimalRaw i)
readDecimalP :: forall i. (Integral i, Read i) => ReadP (DecimalRaw i)
readDecimalP = do
          ReadP ()
skipSpaces
          Char
s1           <- Char -> ReadP Char -> ReadP Char
forall {a}. a -> ReadP a -> ReadP a
myOpt Char
'+' (ReadP Char -> ReadP Char) -> ReadP Char -> ReadP Char
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
'+'
          String
intPart      <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
          String
fractPart    <- String -> ReadP String -> ReadP String
forall {a}. a -> ReadP a -> ReadP a
myOpt String
"" (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ do
                            Char
_ <- Char -> ReadP Char
char Char
'.'
                            (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
          Int
expPart <- Int -> ReadP Int -> ReadP Int
forall {a}. a -> ReadP a -> ReadP a
myOpt Int
0 (ReadP Int -> ReadP Int) -> ReadP Int -> ReadP Int
forall a b. (a -> b) -> a -> b
$ do
                            Char
_  <- Char -> ReadP Char
char Char
'e' ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
'E'
                            Char
s2 <- Char -> ReadP Char -> ReadP Char
forall {a}. a -> ReadP a -> ReadP a
myOpt Char
'+' (ReadP Char -> ReadP Char) -> ReadP Char -> ReadP Char
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
'+'
                            (String -> Int) -> ReadP String -> ReadP Int
forall a b. (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Int -> Int
forall {a}. Num a => Char -> a -> a
applySign Char
s2 (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall n. Integral n => String -> n
strToInt) (ReadP String -> ReadP Int) -> ReadP String -> ReadP Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
          let n :: i
n = Char -> i -> i
forall {a}. Num a => Char -> a -> a
applySign Char
s1 (i -> i) -> i -> i
forall a b. (a -> b) -> a -> b
$ String -> i
forall n. Integral n => String -> n
strToInt (String -> i) -> String -> i
forall a b. (a -> b) -> a -> b
$ String
intPart String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fractPart
              e :: Int
e = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fractPart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
expPart
          if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
             then DecimalRaw i -> ReadP (DecimalRaw i)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecimalRaw i -> ReadP (DecimalRaw i))
-> DecimalRaw i -> ReadP (DecimalRaw i)
forall a b. (a -> b) -> a -> b
$ Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
0 (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ i
n i -> i -> i
forall a. Num a => a -> a -> a
* i
10 i -> Int -> i
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int
forall a. Num a => a -> a
negate Int
e
             else if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256
                then DecimalRaw i -> ReadP (DecimalRaw i)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecimalRaw i -> ReadP (DecimalRaw i))
-> DecimalRaw i -> ReadP (DecimalRaw i)
forall a b. (a -> b) -> a -> b
$ Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e) i
n
                else ReadP (DecimalRaw i)
forall a. ReadP a
pfail
    where
       strToInt :: (Integral n) => String -> n
       strToInt :: forall n. Integral n => String -> n
strToInt = (n -> n -> n) -> n -> [n] -> n
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\n
t n
v -> n
10 n -> n -> n
forall a. Num a => a -> a -> a
* n
t n -> n -> n
forall a. Num a => a -> a -> a
+ n
v) n
0 ([n] -> n) -> (String -> [n]) -> String -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> n) -> String -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> n) -> (Char -> Int) -> Char -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (Char -> Int
ord Char
'0') (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
       applySign :: Char -> a -> a
applySign Char
'-' a
v = a -> a
forall a. Num a => a -> a
negate a
v
       applySign Char
_   a
v = a
v
       myOpt :: a -> ReadP a -> ReadP a
myOpt a
d ReadP a
p = ReadP a
p ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
<++ a -> ReadP a
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d


instance (Integral i) => Eq (DecimalRaw i) where
   DecimalRaw i
d1 == :: DecimalRaw i -> DecimalRaw i -> Bool
== DecimalRaw i
d2   =   i
n1 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
n2 where (Word8
_, i
n1, i
n2) = DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
forall i.
Integral i =>
DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
roundMax DecimalRaw i
d1 DecimalRaw i
d2


instance (Integral i) => Ord (DecimalRaw i) where
    compare :: DecimalRaw i -> DecimalRaw i -> Ordering
compare DecimalRaw i
d1 DecimalRaw i
d2 = i -> i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare i
n1 i
n2 where (Word8
_, i
n1, i
n2) = DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
forall i.
Integral i =>
DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
roundMax DecimalRaw i
d1 DecimalRaw i
d2


instance (Integral i) => Num (DecimalRaw i) where
    (Decimal Word8
_ i
0) + :: DecimalRaw i -> DecimalRaw i -> DecimalRaw i
+ DecimalRaw i
d = DecimalRaw i
d
    DecimalRaw i
d + (Decimal Word8
_ i
0) = DecimalRaw i
d
    DecimalRaw i
d1 + DecimalRaw i
d2 = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ i -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i
n1 i -> i -> i
forall a. Num a => a -> a -> a
+ i
n2)
        where (Word8
e, i
n1, i
n2) = DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
forall i.
Integral i =>
DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
roundMax DecimalRaw i
d1 DecimalRaw i
d2
    (Decimal Word8
_ i
0) - :: DecimalRaw i -> DecimalRaw i -> DecimalRaw i
- (Decimal Word8
e i
n) = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (-i
n)
    DecimalRaw i
d - (Decimal Word8
_ i
0) = DecimalRaw i
d
    DecimalRaw i
d1 - DecimalRaw i
d2 = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ i -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i
n1 i -> i -> i
forall a. Num a => a -> a -> a
- i
n2)
        where (Word8
e, i
n1, i
n2) = DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
forall i.
Integral i =>
DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
roundMax DecimalRaw i
d1 DecimalRaw i
d2
    (Decimal Word8
_ i
0) * :: DecimalRaw i -> DecimalRaw i -> DecimalRaw i
* DecimalRaw i
_ = DecimalRaw i
0
    DecimalRaw i
_ * (Decimal Word8
_ i
0) = DecimalRaw i
0
    DecimalRaw i
d1 * DecimalRaw i
d2 = DecimalRaw i -> DecimalRaw i
forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal (DecimalRaw i -> DecimalRaw i) -> DecimalRaw i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ Word8 -> Rational -> DecimalRaw i
forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal Word8
forall a. Bounded a => a
maxBound (Rational -> DecimalRaw i) -> Rational -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ DecimalRaw i -> Rational
forall a. Real a => a -> Rational
toRational DecimalRaw i
d1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* DecimalRaw i -> Rational
forall a. Real a => a -> Rational
toRational DecimalRaw i
d2
    abs :: DecimalRaw i -> DecimalRaw i
abs (Decimal Word8
e i
n) = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ i -> i
forall a. Num a => a -> a
abs i
n
    signum :: DecimalRaw i -> DecimalRaw i
signum (Decimal Word8
_ i
n) = i -> DecimalRaw i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ i -> i
forall a. Num a => a -> a
signum i
n
    fromInteger :: Integer -> DecimalRaw i
fromInteger Integer
n = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
0 (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ Integer -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n

instance (Integral i) => Real (DecimalRaw i) where
    toRational :: DecimalRaw i -> Rational
toRational (Decimal Word8
e i
n) = i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
e)

instance (Integral i) => Fractional (DecimalRaw i) where
  fromRational :: Rational -> DecimalRaw i
fromRational Rational
r =
     let
        v :: Decimal
        v :: Decimal
v = Decimal -> Decimal
forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal (Decimal -> Decimal) -> Decimal -> Decimal
forall a b. (a -> b) -> a -> b
$ Word8 -> Rational -> Decimal
forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal Word8
forall a. Bounded a => a
maxBound Rational
r
     in Decimal -> DecimalRaw i
forall a b.
(Integral a, Integral b) =>
DecimalRaw a -> DecimalRaw b
unsafeDecimalConvert Decimal
v
  DecimalRaw i
a / :: DecimalRaw i -> DecimalRaw i -> DecimalRaw i
/ DecimalRaw i
b = Rational -> DecimalRaw i
forall a. Fractional a => Rational -> a
fromRational (Rational -> DecimalRaw i) -> Rational -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ DecimalRaw i -> Rational
forall a. Real a => a -> Rational
toRational DecimalRaw i
a Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ DecimalRaw i -> Rational
forall a. Real a => a -> Rational
toRational DecimalRaw i
b

instance (Integral i) => RealFrac (DecimalRaw i) where
  properFraction :: forall b. Integral b => DecimalRaw i -> (b, DecimalRaw i)
properFraction DecimalRaw i
a = (b
rnd, Rational -> DecimalRaw i
forall a. Fractional a => Rational -> a
fromRational Rational
rep)
    where
      (b
rnd, Rational
rep) = Rational -> (b, Rational)
forall b. Integral b => Rational -> (b, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational -> (b, Rational)) -> Rational -> (b, Rational)
forall a b. (a -> b) -> a -> b
$ DecimalRaw i -> Rational
forall a. Real a => a -> Rational
toRational DecimalRaw i
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 -> Int -> [(Int, Decimal)]
divide (Decimal Word8
e Integer
n) Int
d
    | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
        case Integer
n Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d of
          (Integer
result, Integer
0) -> [(Int
d, Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e Integer
result)]
          (Integer
result, Integer
r) -> [(Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r,
                           Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e Integer
result),
                          (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r, Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (Integer
resultInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1))]
    | Bool
otherwise = String -> [(Int, Decimal)]
forall a. HasCallStack => String -> a
error String
"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 -> [Integer] -> [Decimal]
allocate (Decimal Word8
e Integer
n) [Integer]
ps
    | Integer
total Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0  =
        String -> [Decimal]
forall a. HasCallStack => String -> a
error String
"Data.Decimal.allocate: allocation list must not sum to zero."
    | Bool
otherwise   = (Integer -> Decimal) -> [Integer] -> [Decimal]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e) ([Integer] -> [Decimal]) -> [Integer] -> [Decimal]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Integer]
ts ([Integer] -> [Integer]
forall a. HasCallStack => [a] -> [a]
tail [Integer]
ts)
    where
      ts :: [Integer]
ts = ((Integer, Integer) -> Integer)
-> [(Integer, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Integer) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, Integer)] -> [Integer])
-> [(Integer, Integer)] -> [Integer]
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Integer -> (Integer, Integer))
-> (Integer, Integer) -> [Integer] -> [(Integer, Integer)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (Integer, Integer) -> Integer -> (Integer, Integer)
forall {b}. Integral b => (b, b) -> b -> (b, b)
nxt (Integer
n, Integer
total) [Integer]
ps
      nxt :: (b, b) -> b -> (b, b)
nxt (b
n1, b
t1) b
p1 = (b
n1 b -> b -> b
forall a. Num a => a -> a -> a
- (b
n1 b -> b -> b
forall a. Num a => a -> a -> a
* b
p1) b -> b -> b
forall a. Integral a => a -> a -> a
`zdiv` b
t1, b
t1 b -> b -> b
forall a. Num a => a -> a -> a
- b
p1)
      zdiv :: a -> a -> a
zdiv a
0 a
0 = a
0
      zdiv a
x a
y = a
x a -> a -> a
forall a. Integral a => a -> a -> a
`divRound` a
y
      total :: Integer
total = [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
ps


-- | Multiply a @DecimalRaw@ by a @RealFrac@ value.
(*.) :: (Integral i, RealFrac r) => DecimalRaw i -> r -> DecimalRaw i
(Decimal Word8
e i
m) *. :: forall i r.
(Integral i, RealFrac r) =>
DecimalRaw i -> r -> DecimalRaw i
*. r
d = Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
e (i -> DecimalRaw i) -> i -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ r -> i
forall b. Integral b => r -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (r -> i) -> r -> i
forall a b. (a -> b) -> a -> b
$ i -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
m r -> r -> r
forall a. Num a => a -> a -> a
* r
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 :: forall a. Integral a => a -> a -> (a, a)
factorN a
d a
val = a -> a -> (a, a)
forall {t}. Num t => a -> t -> (t, a)
factorN' a
val a
0
  where
    factorN' :: a -> t -> (t, a)
factorN' a
1 t
acc = (t
acc, a
1)
    factorN' a
v t
acc = if a
md a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                     then a -> t -> (t, a)
factorN' a
vd (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
                     else (t
acc, a
v)
      where
        (a
vd, a
md) = a
v a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
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 :: forall i. Integral i => Rational -> Either String (DecimalRaw i)
eitherFromRational Rational
r = if Integer
done Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
                       then do
                         Word8
wres <- Either String Word8
we
                         DecimalRaw i -> Either String (DecimalRaw i)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecimalRaw i -> Either String (DecimalRaw i))
-> DecimalRaw i -> Either String (DecimalRaw i)
forall a b. (a -> b) -> a -> b
$ Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
wres (Integer -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m)
                       else String -> Either String (DecimalRaw i)
forall a b. a -> Either a b
Left (String -> Either String (DecimalRaw i))
-> String -> Either String (DecimalRaw i)
forall a b. (a -> b) -> a -> b
$ Rational -> String
forall a. Show a => a -> String
show Rational
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has no decimal denominator"
  where
    den :: Integer
den = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r
    num :: Integer
num = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r
    (Integer
f2, Integer
rest) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
factorN Integer
2 Integer
den
    (Integer
f5, Integer
done) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
factorN Integer
5 Integer
rest
    e :: Integer
e = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
f2 Integer
f5
    m :: Integer
m = Integer
num Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ((Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
e) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
den)
    we :: Either String Word8
we = if Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
forall a. Bounded a => a
maxBound :: Word8)
         then String -> Either String Word8
forall a b. a -> Either a b
Left (String -> Either String Word8) -> String -> Either String Word8
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is too big ten power to represent as Decimal"
         else Word8 -> Either String Word8
forall a b. b -> Either a b
Right (Word8 -> Either String Word8) -> Word8 -> Either String Word8
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
e

-- | Reduce the exponent of the decimal number to the minimal possible value
normalizeDecimal :: (Integral i) => DecimalRaw i -> DecimalRaw i
normalizeDecimal :: forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal DecimalRaw i
r = case Rational -> Either String (DecimalRaw i)
forall i. Integral i => Rational -> Either String (DecimalRaw i)
eitherFromRational (Rational -> Either String (DecimalRaw i))
-> Rational -> Either String (DecimalRaw i)
forall a b. (a -> b) -> a -> b
$ DecimalRaw i -> Rational
forall a. Real a => a -> Rational
toRational DecimalRaw i
r of
  Right DecimalRaw i
x -> DecimalRaw i
x
  Left String
e -> String -> DecimalRaw i
forall a. HasCallStack => String -> a
error (String -> DecimalRaw i) -> String -> DecimalRaw i
forall a b. (a -> b) -> a -> b
$ String
"Impossible happened: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e