{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Data.BigDecimal
( BigDecimal (..),
RoundingMode (..),
RoundingAdvice,
precision,
trim,
nf,
divide,
roundBD,
fromRatio,
halfUp,
fromString,
fromStringMaybe,
fromNatural,
matchScales,
)
where
import Data.List (elemIndex)
import Data.Maybe (fromJust, fromMaybe)
import GHC.Natural (Natural)
import GHC.Real (Ratio ((:%)))
import Text.Read (readMaybe)
data BigDecimal = BigDecimal
{
BigDecimal -> Integer
value :: Integer,
BigDecimal -> Natural
scale :: Natural
}
type RoundingAdvice = (RoundingMode, Maybe Natural)
data RoundingMode
=
UP
|
DOWN
|
CEILING
|
FLOOR
|
HALF_UP
|
HALF_DOWN
|
HALF_EVEN
|
PRECISE
instance Show BigDecimal where
show :: BigDecimal -> String
show = BigDecimal -> String
toString
instance Read BigDecimal where
readsPrec :: Int -> ReadS BigDecimal
readsPrec Int
_ String
str =
case String -> Maybe BigDecimal
fromStringMaybe String
str of
Maybe BigDecimal
Nothing -> []
(Just BigDecimal
bd) -> [(BigDecimal
bd, String
"")]
instance Num BigDecimal where
BigDecimal
a + :: BigDecimal -> BigDecimal -> BigDecimal
+ BigDecimal
b = (BigDecimal, BigDecimal) -> BigDecimal
plus (BigDecimal
a, BigDecimal
b)
BigDecimal
a * :: BigDecimal -> BigDecimal -> BigDecimal
* BigDecimal
b = (BigDecimal, BigDecimal) -> BigDecimal
mul (BigDecimal
a, BigDecimal
b)
abs :: BigDecimal -> BigDecimal
abs (BigDecimal Integer
v Natural
s) = Integer -> Natural -> BigDecimal
BigDecimal (forall a. Num a => a -> a
abs Integer
v) Natural
s
signum :: BigDecimal -> BigDecimal
signum (BigDecimal Integer
v Natural
_) = Integer -> Natural -> BigDecimal
BigDecimal (forall a. Num a => a -> a
signum Integer
v) Natural
0
fromInteger :: Integer -> BigDecimal
fromInteger Integer
i = Integer -> Natural -> BigDecimal
BigDecimal Integer
i Natural
0
negate :: BigDecimal -> BigDecimal
negate (BigDecimal Integer
v Natural
s) = Integer -> Natural -> BigDecimal
BigDecimal (- Integer
v) Natural
s
instance Eq BigDecimal where
BigDecimal
a == :: BigDecimal -> BigDecimal -> Bool
== BigDecimal
b =
let (BigDecimal Integer
valA Natural
_, BigDecimal Integer
valB Natural
_) = (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal)
matchScales (BigDecimal
a, BigDecimal
b)
in Integer
valA forall a. Eq a => a -> a -> Bool
== Integer
valB
instance Fractional BigDecimal where
BigDecimal
a / :: BigDecimal -> BigDecimal -> BigDecimal
/ BigDecimal
b = BigDecimal -> BigDecimal
nf forall a b. (a -> b) -> a -> b
$ (BigDecimal, BigDecimal) -> RoundingAdvice -> BigDecimal
divide ((BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal)
matchScales (BigDecimal
a, BigDecimal
b)) (RoundingMode
HALF_UP, forall a. Maybe a
Nothing)
fromRational :: Rational -> BigDecimal
fromRational Rational
ratio = Rational -> RoundingAdvice -> BigDecimal
fromRatio Rational
ratio (RoundingMode
HALF_UP, forall a. Maybe a
Nothing)
fromRatio :: Rational -> RoundingAdvice -> BigDecimal
fromRatio :: Rational -> RoundingAdvice -> BigDecimal
fromRatio (Integer
x :% Integer
y) = BigDecimal -> BigDecimal
nf forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BigDecimal, BigDecimal) -> RoundingAdvice -> BigDecimal
divide (forall a. Num a => Integer -> a
fromInteger Integer
x, forall a. Num a => Integer -> a
fromInteger Integer
y)
instance Real BigDecimal where
toRational :: BigDecimal -> Rational
toRational (BigDecimal Integer
val Natural
scl) = forall a. Real a => a -> Rational
toRational Integer
val forall a. Num a => a -> a -> a
* Rational
10 forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (- forall a. Num a => Natural -> a
fromNatural Natural
scl)
instance Ord BigDecimal where
compare :: BigDecimal -> BigDecimal -> Ordering
compare BigDecimal
a BigDecimal
b =
let (BigDecimal Integer
valA Natural
_, BigDecimal Integer
valB Natural
_) = (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal)
matchScales (BigDecimal
a, BigDecimal
b)
in forall a. Ord a => a -> a -> Ordering
compare Integer
valA Integer
valB
plus :: (BigDecimal, BigDecimal) -> BigDecimal
plus :: (BigDecimal, BigDecimal) -> BigDecimal
plus (a :: BigDecimal
a@(BigDecimal Integer
valA Natural
scaleA), b :: BigDecimal
b@(BigDecimal Integer
valB Natural
scaleB))
| Natural
scaleA forall a. Eq a => a -> a -> Bool
== Natural
scaleB = Integer -> Natural -> BigDecimal
BigDecimal (Integer
valA forall a. Num a => a -> a -> a
+ Integer
valB) Natural
scaleA
| Bool
otherwise = (BigDecimal, BigDecimal) -> BigDecimal
plus forall a b. (a -> b) -> a -> b
$ (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal)
matchScales (BigDecimal
a, BigDecimal
b)
mul :: (BigDecimal, BigDecimal) -> BigDecimal
mul :: (BigDecimal, BigDecimal) -> BigDecimal
mul (BigDecimal Integer
valA Natural
scaleA, BigDecimal Integer
valB Natural
scaleB) = Integer -> Natural -> BigDecimal
BigDecimal (Integer
valA forall a. Num a => a -> a -> a
* Integer
valB) (Natural
scaleA forall a. Num a => a -> a -> a
+ Natural
scaleB)
divide ::
(BigDecimal, BigDecimal) ->
RoundingAdvice ->
BigDecimal
divide :: (BigDecimal, BigDecimal) -> RoundingAdvice -> BigDecimal
divide (BigDecimal
a, BigDecimal
b) (RoundingMode
rMode, Maybe Natural
prefScale) =
let (BigDecimal Integer
numA Natural
_, BigDecimal Integer
numB Natural
_) = (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal)
matchScales (BigDecimal
a, BigDecimal
b)
maxPrecision :: Natural
maxPrecision = forall a. a -> Maybe a -> a
fromMaybe (BigDecimal -> Natural
precision BigDecimal
a forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral (BigDecimal -> Natural
precision BigDecimal
b) forall a. Num a => a -> a -> a
* Double
10 forall a. Fractional a => a -> a -> a
/ Double
3)) Maybe Natural
prefScale :: Natural
in Natural -> BigDecimal -> BigDecimal
trim Natural
maxPrecision (Integer -> Natural -> BigDecimal
BigDecimal (RoundingMode -> Integer -> Integer -> Integer
divUsing RoundingMode
rMode (Integer
numA forall a. Num a => a -> a -> a
* (Integer
10 :: Integer) forall a b. (Num a, Integral b) => a -> b -> a
^ Natural
maxPrecision) Integer
numB) Natural
maxPrecision)
divUsing :: RoundingMode -> Integer -> Integer -> Integer
divUsing :: RoundingMode -> Integer -> Integer -> Integer
divUsing RoundingMode
rounding Integer
a Integer
b =
let (Integer
quotient, Integer
remainder) = forall a. Integral a => a -> a -> (a, a)
quotRem Integer
a Integer
b
delta :: Integer
delta = (Integer
10 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
abs Integer
remainder forall a. Integral a => a -> a -> a
`div` forall a. Num a => a -> a
abs Integer
b) forall a. Num a => a -> a -> a
- Integer
5
in case RoundingMode
rounding of
RoundingMode
PRECISE -> if Integer
remainder forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer
quotient else forall a. HasCallStack => String -> a
error String
"non-terminating decimal expansion"
RoundingMode
UP -> if forall a. Num a => a -> a
abs Integer
remainder forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer
quotient forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
signum Integer
quotient else Integer
quotient
RoundingMode
CEILING -> if forall a. Num a => a -> a
abs Integer
remainder forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
quotient forall a. Ord a => a -> a -> Bool
>= Integer
0 then Integer
quotient forall a. Num a => a -> a -> a
+ Integer
1 else Integer
quotient
RoundingMode
HALF_UP -> if Integer
delta forall a. Ord a => a -> a -> Bool
>= Integer
0 then Integer
quotient forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
signum Integer
quotient else Integer
quotient
RoundingMode
HALF_DOWN -> if Integer
delta forall a. Ord a => a -> a -> Bool
<= Integer
0 then Integer
quotient else Integer
quotient forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
signum Integer
quotient
RoundingMode
DOWN -> Integer
quotient
RoundingMode
FLOOR -> if Integer
quotient forall a. Ord a => a -> a -> Bool
>= Integer
0 then Integer
quotient else Integer
quotient forall a. Num a => a -> a -> a
- Integer
1
RoundingMode
HALF_EVEN
| Integer
delta forall a. Ord a => a -> a -> Bool
> Integer
0 -> Integer
quotient forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
signum Integer
quotient
| Integer
delta forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& forall a. Integral a => a -> Bool
odd Integer
quotient -> Integer
quotient forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
signum Integer
quotient
| Bool
otherwise -> Integer
quotient
roundBD :: BigDecimal -> RoundingAdvice -> BigDecimal
roundBD :: BigDecimal -> RoundingAdvice -> BigDecimal
roundBD bd :: BigDecimal
bd@(BigDecimal Integer
val Natural
scl) (RoundingMode
rMode, Just Natural
n)
| Natural
n forall a. Ord a => a -> a -> Bool
< Natural
0 Bool -> Bool -> Bool
|| Natural
n forall a. Ord a => a -> a -> Bool
>= Natural
scl = BigDecimal
bd
| Bool
otherwise = Integer -> Natural -> BigDecimal
BigDecimal (RoundingMode -> Integer -> Integer -> Integer
divUsing RoundingMode
rMode Integer
val (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Natural
scl forall a. Num a => a -> a -> a
- Natural
n))) Natural
n
roundBD BigDecimal
bd RoundingAdvice
_ = BigDecimal
bd
matchScales :: (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal)
matchScales :: (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal)
matchScales (a :: BigDecimal
a@(BigDecimal Integer
integerA Natural
scaleA), b :: BigDecimal
b@(BigDecimal Integer
integerB Natural
scaleB))
| Natural
scaleA forall a. Ord a => a -> a -> Bool
< Natural
scaleB = (Integer -> Natural -> BigDecimal
BigDecimal (Integer
integerA forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Natural
scaleB forall a. Num a => a -> a -> a
- Natural
scaleA)) Natural
scaleB, BigDecimal
b)
| Natural
scaleA forall a. Ord a => a -> a -> Bool
> Natural
scaleB = (BigDecimal
a, Integer -> Natural -> BigDecimal
BigDecimal (Integer
integerB forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Natural
scaleA forall a. Num a => a -> a -> a
- Natural
scaleB)) Natural
scaleA)
| Bool
otherwise = (BigDecimal
a, BigDecimal
b)
precision :: BigDecimal -> Natural
precision :: BigDecimal -> Natural
precision = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigDecimal -> Integer
value
trim :: Natural -> BigDecimal -> BigDecimal
trim :: Natural -> BigDecimal -> BigDecimal
trim Natural
prefScale bd :: BigDecimal
bd@(BigDecimal Integer
val Natural
scl) =
let (Integer
v, Integer
r) = forall a. Integral a => a -> a -> (a, a)
quotRem Integer
val Integer
10
in if Integer
r forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Natural
0 forall a. Ord a => a -> a -> Bool
<= Natural
prefScale Bool -> Bool -> Bool
&& Natural
prefScale forall a. Ord a => a -> a -> Bool
< Natural
scl
then Natural -> BigDecimal -> BigDecimal
trim Natural
prefScale forall a b. (a -> b) -> a -> b
$ Integer -> Natural -> BigDecimal
BigDecimal Integer
v (Natural
scl forall a. Num a => a -> a -> a
- Natural
1)
else BigDecimal
bd
nf :: BigDecimal -> BigDecimal
nf :: BigDecimal -> BigDecimal
nf = Natural -> BigDecimal -> BigDecimal
trim Natural
0
fromString :: String -> BigDecimal
fromString :: String -> BigDecimal
fromString = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe BigDecimal
fromStringMaybe
fromStringMaybe :: String -> Maybe BigDecimal
fromStringMaybe :: String -> Maybe BigDecimal
fromStringMaybe String
s =
let maybeIndex :: Maybe Int
maybeIndex = forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
'.' String
s
maybeIntValue :: Maybe Integer
maybeIntValue = forall a. Read a => String -> Maybe a
readMaybe (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'.') String
s)
in do
Integer
intValue <- Maybe Integer
maybeIntValue
case Maybe Int
maybeIndex of
Maybe Int
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Natural -> BigDecimal
BigDecimal Integer
intValue Natural
0
Just Int
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Natural -> BigDecimal
BigDecimal Integer
intValue (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Num a => a -> a -> a
- Int
i forall a. Num a => a -> a -> a
- Int
1))
toString :: BigDecimal -> String
toString :: BigDecimal -> String
toString (BigDecimal Integer
intValue Natural
scl) =
let s :: String
s = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs Integer
intValue
filled :: String
filled =
if forall a. Num a => Natural -> a
fromNatural Natural
scl forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
then forall a. Int -> a -> [a]
replicate (Int
1 forall a. Num a => a -> a -> a
+ forall a. Num a => Natural -> a
fromNatural Natural
scl forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' forall a. [a] -> [a] -> [a]
++ String
s
else String
s
splitPos :: Int
splitPos = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
filled forall a. Num a => a -> a -> a
- forall a. Num a => Natural -> a
fromNatural Natural
scl
(String
ints, String
decimals) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
splitPos String
filled
sign :: String
sign = if Integer
intValue forall a. Ord a => a -> a -> Bool
< Integer
0 then String
"-" else String
""
in String
sign forall a. [a] -> [a] -> [a]
++ if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
decimals) then String
ints forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
decimals else String
ints
halfUp :: Natural -> RoundingAdvice
halfUp :: Natural -> RoundingAdvice
halfUp Natural
scl = (RoundingMode
HALF_UP, forall a. a -> Maybe a
Just Natural
scl)
fromNatural :: Num a => Natural -> a
fromNatural :: forall a. Num a => Natural -> a
fromNatural = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger