module QuantLib.Money
        ( module QuantLib.Money
        ) where

import QuantLib.Currency
import QuantLib.Currencies.Europe (eur)

-- | Amount of cash. Please, note that currency conversion is not implemented yet.
data Money = Money {
        Money -> Double
mValue          :: Double,
        Money -> Currency
mCurrency       :: Currency
        } deriving (Money -> Money -> Bool
(Money -> Money -> Bool) -> (Money -> Money -> Bool) -> Eq Money
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Money -> Money -> Bool
$c/= :: Money -> Money -> Bool
== :: Money -> Money -> Bool
$c== :: Money -> Money -> Bool
Eq)

instance Show Money where
        showsPrec :: Int -> Money -> ShowS
showsPrec Int
_ (Money Double
v Currency
c) String
s = Double -> String
forall a. Show a => a -> String
show Double
vString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++Currency -> String
forall a. Show a => a -> String
show Currency
cString -> ShowS
forall a. [a] -> [a] -> [a]
++String
s

instance Num Money where
        + :: Money -> Money -> Money
(+) (Money Double
v0 Currency
c0) (Money Double
v1 Currency
c1)
                | Currency
c0 Currency -> Currency -> Bool
forall a. Eq a => a -> a -> Bool
== Currency
c1      = Double -> Currency -> Money
Money (Double
v0Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
v1) Currency
c0
                | Bool
otherwise     = String -> Money
forall a. HasCallStack => String -> a
error String
"Currency conversion is not implemented"
        * :: Money -> Money -> Money
(*) Money
_ Money
_         = String -> Money
forall a. HasCallStack => String -> a
error String
"Multiplying moneys has no sense"
        (-) (Money Double
v0 Currency
c0) (Money Double
v1 Currency
c1)
                | Currency
c0 Currency -> Currency -> Bool
forall a. Eq a => a -> a -> Bool
== Currency
c1      = Double -> Currency -> Money
Money (Double
v0Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
v1) Currency
c0
                | Bool
otherwise     = String -> Money
forall a. HasCallStack => String -> a
error String
"Currency conversion is not implemented"
        negate :: Money -> Money
negate (Money Double
v Currency
c)      = Double -> Currency -> Money
Money (-Double
v) Currency
c
        abs :: Money -> Money
abs    (Money Double
v Currency
c)      = Double -> Currency -> Money
Money (Double -> Double
forall a. Num a => a -> a
abs Double
v) Currency
c
        signum :: Money -> Money
signum (Money Double
v Currency
c)      = Double -> Currency -> Money
Money (Double -> Double
forall a. Num a => a -> a
signum Double
v) Currency
c
        fromInteger :: Integer -> Money
fromInteger     Integer
i       = Double -> Currency -> Money
Money (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i) Currency
eur