{-# OPTIONS_GHC -fno-warn-type-defaults #-} -- avoids  warnings for things like x^2

-- -- | This module defines the type 'BigDecimal' which provides a representation of arbitrary precision decimal numbers.

--     'BigDecimal' is a native Haskell implementation based on arbitrary sized 'Integer' values.

--     The implementation was inspired by Java BigDecimals.

--

--      BigDecimal instantiates the typeclasses 'Num', 'Fractional' and 'Real'. It is thus possible to use all common

--          operators like '+', '-', '*', '/', '^' on them.

--

--       Here are a few examples from an interactive GHCI session:

--

--      >  λ> a = BigDecimal 144 2

--      >  λ> toString a

--      >  1.44

--      >  λ> b = sqrt a

--      >  λ> b

--      >  1.2

--      >  λ> b * b

--      >  1.44

--      >  λ> b * b * b

--      >  1.728

--      >  λ> b^2

--      >  1.44

--      >  λ> c = read "123.4567890" :: BigDecimal

--      >  λ> c

--      >  123.4567890

--      >  λ> a / c

--      >  0.01166400010614240096589584878965222398584

--      >  λ> roundBD it (halfUp 10)

--      >  0.0116640001

--      >  λ> divide (a, c) $ halfUp 20

--      >  0.01166400010614240097

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)

-- | BigDecimal is represented by an unscaled Integer value and a Natural that defines the scale

--   E.g.: (BigDecimal 1234 2) represents the decimal value 12.34.

data BigDecimal = BigDecimal
  { -- | the unscaled Integer value

    BigDecimal -> Integer
value :: Integer,
    -- | the scale (i.e. the number of digits after the decimal point)

    BigDecimal -> Natural
scale :: Natural
  }

-- | A RoundingAdvice is interpreted by divisions and rounding operations to specify the expected loss of precision and the rounding behaviour.

--   RoundingAdvice is a pair of a 'RoundingMode' and a target precision of type 'Maybe' 'Natural'. The precision defines the number of digits after the decimal point.

--   If 'Nothing' is given as precision all decimal digits are to be preserved, that is precision is not limited.

type RoundingAdvice = (RoundingMode, Maybe Natural)

-- | RoundingMode defines how to handle loss of precision in divisions or explicit rounding.

data RoundingMode
  = -- | Rounding mode to round away from zero.

    UP
  | -- | Rounding mode to round towards zero.

    DOWN
  | -- | Rounding mode to round towards positive infinity.

    CEILING
  | -- | Rounding mode to round towards negative infinity.

    FLOOR
  | -- | Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round up.

    HALF_UP
  | -- | Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round down.

    HALF_DOWN
  | -- | Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case, round towards the even neighbor.

    HALF_EVEN
  | -- | Rounding mode to assert that the requested operation has an exact result, hence no rounding is applied.

    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
  -- default division rounds up and does not limit precision

  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)

-- | creates a BigDecimal from a 'Rational' value. 'RoundingAdvice' defines precision and rounding mode.

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

-- | add two BigDecimals

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)

-- | multiply two BigDecimals

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 two BigDecimals and applies the 'RoundingAdvice' (i.e. a tuple of 'RoundingMode' and the specified precision) for rounding.

divide ::
  -- |  the tuple of dividend and divisor. I.e. (dividend, divisor)

  (BigDecimal, BigDecimal) ->
  -- | 'RoundingAdvice' (i.e. a tuple of 'RoundingMode' and the specified precision) defines the rounding behaviour.

  --   if 'Nothing' if given as precision the maximum possible precision is used.

  RoundingAdvice ->
  -- | the resulting BigDecimal

  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)

-- | divide two correctly scaled Integers and apply the RoundingMode

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

-- | round a BigDecimal according to a 'RoundingAdvice' to 'n' digits applying the 'RoundingMode' 'rMode'

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

-- | match the scales of a tuple of BigDecimals

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)

-- | returns the number of digits of a BigDecimal.

precision :: BigDecimal -> Natural
-- see benchmark/Main.hs

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

-- | removes trailing zeros from a BigDecimals intValue by decreasing the scale

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

-- | computes the normal form of a BigDecimal

nf :: BigDecimal -> BigDecimal
nf :: BigDecimal -> BigDecimal
nf = Natural -> BigDecimal -> BigDecimal
trim Natural
0

-- | read a BigDecimal from a human readable decimal notation.

--   e.g. @ fromString "3.14" @ yields 'BigDecimal 314 2'

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

-- | read a BigDecimal from a human readable decimal notation.

--   e.g. @ fromString "3.14" @ yields 'BigDecimal 314 2'

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))

-- | returns a readable String representation of a BigDecimal

--   e.g. @ toString (BigDecimal 314 2) @ yields "3.14"

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

-- | construct a 'RoundingAdvice' for rounding 'HALF_UP' with 'scl' decimal digits

halfUp :: Natural -> RoundingAdvice
halfUp :: Natural -> RoundingAdvice
halfUp Natural
scl = (RoundingMode
HALF_UP, forall a. a -> Maybe a
Just Natural
scl)

-- | convert a Natural to any numeric type a

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