{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE KindSignatures #-}

module Haspara.Internal.Money where

import           Control.Applicative       ((<|>))
import           Data.Aeson                ((.:), (.=))
import qualified Data.Aeson                as Aeson
import           Data.Scientific           (Scientific)
import           GHC.TypeLits              (KnownNat, Nat)
import           Haspara.Internal.Currency (Currency, baseCurrency, quoteCurrency)
import           Haspara.Internal.Date     (Date)
import           Haspara.Internal.FXQuote  (FXQuote(fxQuotePair, fxQuoteRate))
import           Haspara.Internal.Quantity (Quantity, quantity, times)
import           Refined                   (unrefine)


data Money (s :: Nat) =
    MoneySome Date Currency (Quantity s)
  | MoneyZero
  | MoneyFail String
  deriving (Money s -> Money s -> Bool
(Money s -> Money s -> Bool)
-> (Money s -> Money s -> Bool) -> Eq (Money s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Nat). Money s -> Money s -> Bool
/= :: Money s -> Money s -> Bool
$c/= :: forall (s :: Nat). Money s -> Money s -> Bool
== :: Money s -> Money s -> Bool
$c== :: forall (s :: Nat). Money s -> Money s -> Bool
Eq, Eq (Money s)
Eq (Money s)
-> (Money s -> Money s -> Ordering)
-> (Money s -> Money s -> Bool)
-> (Money s -> Money s -> Bool)
-> (Money s -> Money s -> Bool)
-> (Money s -> Money s -> Bool)
-> (Money s -> Money s -> Money s)
-> (Money s -> Money s -> Money s)
-> Ord (Money s)
Money s -> Money s -> Bool
Money s -> Money s -> Ordering
Money s -> Money s -> Money s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (s :: Nat). Eq (Money s)
forall (s :: Nat). Money s -> Money s -> Bool
forall (s :: Nat). Money s -> Money s -> Ordering
forall (s :: Nat). Money s -> Money s -> Money s
min :: Money s -> Money s -> Money s
$cmin :: forall (s :: Nat). Money s -> Money s -> Money s
max :: Money s -> Money s -> Money s
$cmax :: forall (s :: Nat). Money s -> Money s -> Money s
>= :: Money s -> Money s -> Bool
$c>= :: forall (s :: Nat). Money s -> Money s -> Bool
> :: Money s -> Money s -> Bool
$c> :: forall (s :: Nat). Money s -> Money s -> Bool
<= :: Money s -> Money s -> Bool
$c<= :: forall (s :: Nat). Money s -> Money s -> Bool
< :: Money s -> Money s -> Bool
$c< :: forall (s :: Nat). Money s -> Money s -> Bool
compare :: Money s -> Money s -> Ordering
$ccompare :: forall (s :: Nat). Money s -> Money s -> Ordering
$cp1Ord :: forall (s :: Nat). Eq (Money s)
Ord, Int -> Money s -> ShowS
[Money s] -> ShowS
Money s -> String
(Int -> Money s -> ShowS)
-> (Money s -> String) -> ([Money s] -> ShowS) -> Show (Money s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Nat). KnownNat s => Int -> Money s -> ShowS
forall (s :: Nat). KnownNat s => [Money s] -> ShowS
forall (s :: Nat). KnownNat s => Money s -> String
showList :: [Money s] -> ShowS
$cshowList :: forall (s :: Nat). KnownNat s => [Money s] -> ShowS
show :: Money s -> String
$cshow :: forall (s :: Nat). KnownNat s => Money s -> String
showsPrec :: Int -> Money s -> ShowS
$cshowsPrec :: forall (s :: Nat). KnownNat s => Int -> Money s -> ShowS
Show)


-- | 'Aeson.FromJSON' instance for 'Money'.
--
-- >>> Aeson.decode "{\"qty\":42,\"ccy\":\"USD\",\"date\":\"2021-01-01\"}" :: Maybe (Money 2)
-- Just (MoneySome 2021-01-01 USD 42.00)
-- >>> Aeson.decode "0" :: Maybe (Money 2)
-- Just MoneyZero
-- >>> Aeson.decode "{\"error\": \"oops\"}" :: Maybe (Money 2)
-- Just (MoneyFail "oops")
instance (KnownNat s) => Aeson.FromJSON (Money s) where
  parseJSON :: Value -> Parser (Money s)
parseJSON (Aeson.Number Scientific
0) = Money s -> Parser (Money s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Money s
forall (s :: Nat). Money s
MoneyZero
  parseJSON (Aeson.Object Object
obj) = Object -> Parser (Money s)
forall (s :: Nat). KnownNat s => Object -> Parser (Money s)
parseSome Object
obj Parser (Money s) -> Parser (Money s) -> Parser (Money s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser (Money s)
forall (s :: Nat). Object -> Parser (Money s)
parseFail Object
obj
    where
      parseSome :: Object -> Parser (Money s)
parseSome Object
o = Date -> Currency -> Quantity s -> Money s
forall (s :: Nat). Date -> Currency -> Quantity s -> Money s
MoneySome
        (Date -> Currency -> Quantity s -> Money s)
-> Parser Date -> Parser (Currency -> Quantity s -> Money s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Date
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date"
        Parser (Currency -> Quantity s -> Money s)
-> Parser Currency -> Parser (Quantity s -> Money s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Currency
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ccy"
        Parser (Quantity s -> Money s)
-> Parser (Quantity s) -> Parser (Money s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Quantity s)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"qty"
      parseFail :: Object -> Parser (Money s)
parseFail Object
o = String -> Money s
forall (s :: Nat). String -> Money s
MoneyFail (String -> Money s) -> Parser String -> Parser (Money s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"error"
  parseJSON Value
x = String -> Parser (Money s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Not a monetary value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x)



-- | 'Aeson.ToJSON' instance for 'Money'.
--
-- >>> Aeson.encode (MoneySome (read "2021-01-01") ("USD" :: Currency) (42 :: Quantity 0))
-- "{\"qty\":42,\"ccy\":\"USD\",\"date\":\"2021-01-01\"}"
-- >>> Aeson.encode (MoneyZero :: Money 2)
-- "0"
-- >>> Aeson.encode (MoneyFail "oops" :: Money 2)
-- "{\"error\":\"oops\"}"
instance (KnownNat s) => Aeson.ToJSON (Money s) where
  toJSON :: Money s -> Value
toJSON (MoneySome Date
d Currency
c Quantity s
q) = [Pair] -> Value
Aeson.object [ Text
"date" Text -> Date -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Date
d, Text
"ccy" Text -> Currency -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Currency
c, Text
"qty" Text -> Quantity s -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Quantity s
q ]
  toJSON Money s
MoneyZero         = Scientific -> Value
Aeson.Number Scientific
0
  toJSON (MoneyFail String
s)     = [Pair] -> Value
Aeson.object [Text
"error" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
s]


mkMoney :: KnownNat s => Date -> Currency -> Quantity s -> Money s
mkMoney :: Date -> Currency -> Quantity s -> Money s
mkMoney = Date -> Currency -> Quantity s -> Money s
forall (s :: Nat). Date -> Currency -> Quantity s -> Money s
MoneySome


mkMoneyFromScientific :: KnownNat s => Date -> Currency -> Scientific -> Money s
mkMoneyFromScientific :: Date -> Currency -> Scientific -> Money s
mkMoneyFromScientific Date
d Currency
c Scientific
s = Date -> Currency -> Quantity s -> Money s
forall (s :: Nat).
KnownNat s =>
Date -> Currency -> Quantity s -> Money s
mkMoney Date
d Currency
c (Scientific -> Quantity s
forall (s :: Nat). KnownNat s => Scientific -> Quantity s
quantity Scientific
s)


moneyDate :: KnownNat s => Money s -> Maybe Date
moneyDate :: Money s -> Maybe Date
moneyDate (MoneySome Date
d Currency
_ Quantity s
_) = Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d
moneyDate Money s
MoneyZero         = Maybe Date
forall a. Maybe a
Nothing
moneyDate (MoneyFail String
_)     = Maybe Date
forall a. Maybe a
Nothing


moneyCurrency :: KnownNat s => Money s -> Maybe Currency
moneyCurrency :: Money s -> Maybe Currency
moneyCurrency (MoneySome Date
_ Currency
c Quantity s
_) = Currency -> Maybe Currency
forall a. a -> Maybe a
Just Currency
c
moneyCurrency Money s
MoneyZero         = Maybe Currency
forall a. Maybe a
Nothing
moneyCurrency (MoneyFail String
_)     = Maybe Currency
forall a. Maybe a
Nothing


moneyQuantity :: KnownNat s => Money s -> Maybe (Quantity s)
moneyQuantity :: Money s -> Maybe (Quantity s)
moneyQuantity (MoneySome Date
_ Currency
_ Quantity s
q) = Quantity s -> Maybe (Quantity s)
forall a. a -> Maybe a
Just Quantity s
q
moneyQuantity Money s
MoneyZero         = Maybe (Quantity s)
forall a. Maybe a
Nothing
moneyQuantity (MoneyFail String
_)     = Maybe (Quantity s)
forall a. Maybe a
Nothing


-- | Converts the given 'Money' value to another given currency with the given
-- rate.
--
-- >>> import Haspara
-- >>> let eur = either error id $ currency "EUR"
-- >>> let usd = either error id $ currency "USD"
-- >>> let date = read "2021-01-01" :: Date
-- >>> let eurmoney = mkMoney date eur (quantity 0.42 :: Quantity 2) :: Money 2
-- >>> convert eurmoney eur (quantity 1 :: Quantity 4)
-- MoneySome 2021-01-01 EUR 0.42
-- >>> convert eurmoney usd (quantity 1 :: Quantity 4)
-- MoneySome 2021-01-01 USD 0.42
-- >>> convert eurmoney usd (quantity 1.1516 :: Quantity 4)
-- MoneySome 2021-01-01 USD 0.48
convert :: (KnownNat s, KnownNat k) => Money s -> Currency -> Quantity k -> Money s
convert :: Money s -> Currency -> Quantity k -> Money s
convert Money s
MoneyZero Currency
_ Quantity k
_                    = Money s
forall (s :: Nat). Money s
MoneyZero
convert x :: Money s
x@(MoneyFail String
_) Currency
_ Quantity k
_              = Money s
x
convert x :: Money s
x@(MoneySome Date
d Currency
cbase Quantity s
q) Currency
cquot Quantity k
rate
  | Currency
cbase Currency -> Currency -> Bool
forall a. Eq a => a -> a -> Bool
== Currency
cquot Bool -> Bool -> Bool
&& Quantity k
rate Quantity k -> Quantity k -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity k
1 = Money s
x
  | Currency
cbase Currency -> Currency -> Bool
forall a. Eq a => a -> a -> Bool
== Currency
cquot Bool -> Bool -> Bool
&& Quantity k
rate Quantity k -> Quantity k -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity k
1 = String -> Money s
forall (s :: Nat). String -> Money s
MoneyFail (String -> Money s) -> String -> Money s
forall a b. (a -> b) -> a -> b
$ String
"Attempting to convert from same currency with rate != 1: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Money s -> String
forall a. Show a => a -> String
show Money s
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Currency -> String
forall a. Show a => a -> String
show Currency
cquot String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Quantity k -> String
forall a. Show a => a -> String
show Quantity k
rate
  | Bool
otherwise                   = Date -> Currency -> Quantity s -> Money s
forall (s :: Nat). Date -> Currency -> Quantity s -> Money s
MoneySome Date
d Currency
cquot (Quantity s -> Quantity k -> Quantity s
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
times Quantity s
q Quantity k
rate)


-- | Converts the given 'Money' value to another currency with the given
-- 'FXQuote'.
convertWithQuote :: (KnownNat s, KnownNat k) => Money s -> FXQuote k -> Money s
convertWithQuote :: Money s -> FXQuote k -> Money s
convertWithQuote Money s
MoneyZero FXQuote k
_                    = Money s
forall (s :: Nat). Money s
MoneyZero
convertWithQuote x :: Money s
x@(MoneyFail String
_) FXQuote k
_              = Money s
x
convertWithQuote x :: Money s
x@(MoneySome Date
_ Currency
cbase Quantity s
_) FXQuote k
quote
  | Currency
cbase Currency -> Currency -> Bool
forall a. Eq a => a -> a -> Bool
/= CurrencyPair -> Currency
baseCurrency (FXQuote k -> CurrencyPair
forall (s :: Nat). FXQuote s -> CurrencyPair
fxQuotePair FXQuote k
quote) = String -> Money s
forall (s :: Nat). String -> Money s
MoneyFail (String -> Money s) -> String -> Money s
forall a b. (a -> b) -> a -> b
$ String
"Attempting to convert with incompatible base currency: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Money s -> String
forall a. Show a => a -> String
show Money s
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FXQuote k -> String
forall a. Show a => a -> String
show FXQuote k
quote
  | Bool
otherwise = Money s -> Currency -> Quantity k -> Money s
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Money s -> Currency -> Quantity k -> Money s
convert Money s
x (CurrencyPair -> Currency
quoteCurrency (FXQuote k -> CurrencyPair
forall (s :: Nat). FXQuote s -> CurrencyPair
fxQuotePair FXQuote k
quote)) (Refined Positive (Quantity k) -> Quantity k
forall p x. Refined p x -> x
unrefine (Refined Positive (Quantity k) -> Quantity k)
-> Refined Positive (Quantity k) -> Quantity k
forall a b. (a -> b) -> a -> b
$ FXQuote k -> Refined Positive (Quantity k)
forall (s :: Nat). FXQuote s -> Refined Positive (Quantity s)
fxQuoteRate FXQuote k
quote)