-- | This module provides definitions for modeling and working with monetary
-- values.

{-# LANGUAGE DataKinds   #-}
{-# LANGUAGE DerivingVia #-}

module Haspara.Monetary where

import           Control.Exception      (Exception)
import           Control.Monad          (when)
import           Control.Monad.Catch    (MonadThrow(throwM))
import qualified Data.Aeson             as Aeson
import           Data.Time              (Day)
import           GHC.Generics           (Generic)
import           GHC.Stack              (HasCallStack)
import           GHC.TypeLits           (KnownNat, Nat)
import           Haspara.Currency       (Currency, CurrencyPair(..))
import           Haspara.FxQuote        (FxQuote(..))
import           Haspara.Internal.Aeson (commonAesonOptions)
import           Haspara.Quantity       (Quantity, times)
import           Refined                (unrefine)


-- | Type encoding for dated monetary values.
--
-- A dated monetary value is a 3-tuple of:
--
-- 1. a date when the monetary value is effective as of,
-- 2. the currency of the monetary value, and
-- 3. the quantity of the monetary value.
data Money (s :: Nat) = Money
  { Money s -> Day
moneyDate     :: !Day
  , Money s -> Currency
moneyCurrency :: !Currency
  , Money s -> Quantity s
moneyQuantity :: !(Quantity s)
  }
  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, (forall x. Money s -> Rep (Money s) x)
-> (forall x. Rep (Money s) x -> Money s) -> Generic (Money s)
forall x. Rep (Money s) x -> Money s
forall x. Money s -> Rep (Money s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Nat) x. Rep (Money s) x -> Money s
forall (s :: Nat) x. Money s -> Rep (Money s) x
$cto :: forall (s :: Nat) x. Rep (Money s) x -> Money s
$cfrom :: forall (s :: Nat) x. Money s -> Rep (Money s) x
Generic, 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)


instance KnownNat s => Aeson.FromJSON (Money s) where
  parseJSON :: Value -> Parser (Money s)
parseJSON = Options -> Value -> Parser (Money s)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser (Money s))
-> Options -> Value -> Parser (Money s)
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"money"


instance KnownNat s => Aeson.ToJSON (Money s) where
  toJSON :: Money s -> Value
toJSON = Options -> Money s -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> Money s -> Value) -> Options -> Money s -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"money"


-- | Type encoding of a monetary context.
class MonadThrow m => Monetary m where
  -- | Converts the given monetary value in one currency to another currency.
  --
  -- Note that the conversion is performed with an FX rate quotation as of the
  -- date of the given monetary value.
  convertM
    :: HasCallStack
    => KnownNat s
    => Currency
    -> Money s
    -> m (Money s)

  -- | Converts the given monetary value in one currency to another currency as
  -- of the given date.
  --
  -- The rule is:
  --
  -- @
  -- convertAsofM <DATE2> <CCY2> (Money <DATE1> <CCY1> <QTY1>) === convertM <CCY2> (Money <DATE2> <CCY1> <QTY1>)
  -- @
  convertAsofM
    :: HasCallStack
    => KnownNat s
    => Day
    -> Currency
    -> Money s
    -> m (Money s)
  convertAsofM Day
date Currency
ccyN (Money Day
_ Currency
ccy Quantity s
qty) = Currency -> Money s -> m (Money s)
forall (m :: * -> *) (s :: Nat).
(Monetary m, HasCallStack, KnownNat s) =>
Currency -> Money s -> m (Money s)
convertM Currency
ccyN (Day -> Currency -> Quantity s -> Money s
forall (s :: Nat). Day -> Currency -> Quantity s -> Money s
Money Day
date Currency
ccy Quantity s
qty)


-- | Attempts to convert the given 'Money' to another using the given 'FxQuote'
-- value.
--
-- This function runs some guards before attempting to do the conversion:
--
-- 1. Base currency of the FX rate quotation should be the same as the currency
--    of the monetary value, throws 'IncompatibleCurrenciesException' otherwise.
-- 2. Date of the FX rate quotation should be equal to or greater than the date
--    of the monetary value, throws 'IncompatibleDatesException' otherwise.
-- 3. Rate of the FX rate quotation should be @1@ if the base and quote
--    quotation are same, throws 'InconsistentFxQuoteException' otherwise.
convert
  :: HasCallStack
  => MonadThrow m
  => KnownNat s
  => KnownNat k
  => Money s
  -> FxQuote k
  -> m (Money s)
convert :: Money s -> FxQuote k -> m (Money s)
convert (Money Day
date Currency
ccy Quantity s
qty) quote :: FxQuote k
quote@(MkFxQuote (CurrencyPair Currency
ccy1 Currency
ccy2) Day
asof Refined Positive (Quantity k)
rate) = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Currency
ccy Currency -> Currency -> Bool
forall a. Eq a => a -> a -> Bool
/= Currency
ccy1) (MonetaryException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HasCallStack => Currency -> Currency -> MonetaryException
Currency -> Currency -> MonetaryException
IncompatibleCurrenciesException Currency
ccy Currency
ccy1))
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Day
asof Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
date) (MonetaryException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HasCallStack => Day -> Day -> MonetaryException
Day -> Day -> MonetaryException
IncompatibleDatesException Day
date Day
asof))
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Currency
ccy1 Currency -> Currency -> Bool
forall a. Eq a => a -> a -> Bool
== Currency
ccy2 Bool -> Bool -> Bool
&& Refined Positive (Quantity k) -> Quantity k
forall p x. Refined p x -> x
unrefine Refined Positive (Quantity k)
rate Quantity k -> Quantity k -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity k
1) (MonetaryException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FxQuote k -> MonetaryException
forall (s :: Nat).
(HasCallStack, KnownNat s) =>
FxQuote s -> MonetaryException
InconsistentFxQuoteException FxQuote k
quote))
  Money s -> m (Money s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> Currency -> Quantity s -> Money s
forall (s :: Nat). Day -> Currency -> Quantity s -> Money s
Money Day
asof Currency
ccy2 (Quantity s -> Quantity k -> Quantity s
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
times Quantity s
qty (Refined Positive (Quantity k) -> Quantity k
forall p x. Refined p x -> x
unrefine Refined Positive (Quantity k)
rate)))


-- | Type encoding of exceptions thrown by the `Haspara.Monetary` module.
data MonetaryException where
  -- | Indicates that we received a currency other than the expected currency.
  IncompatibleCurrenciesException
    :: HasCallStack
    => Currency  -- ^ Expected currency
    -> Currency  -- ^ Received currency
    -> MonetaryException

  -- | Indicates that we received a currency other than the expected currency.
  IncompatibleDatesException
    :: HasCallStack
    => Day  -- ^ Date on and onwards of interest
    -> Day  -- ^ Date received
    -> MonetaryException

  -- | Indicates that we received a currency other than the expected currency.
  InconsistentFxQuoteException
    :: forall (s :: Nat). (HasCallStack, KnownNat s)
    => FxQuote s  -- ^ FX rate quotation that is interpreted as inconsistent.
    -> MonetaryException


deriving instance Show MonetaryException


instance Exception MonetaryException