{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | This module provides definitions for modeling and working with monetary
-- values.
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
  { forall (s :: Nat). Money s -> Day
moneyDate :: !Day
  , forall (s :: Nat). Money s -> Currency
moneyCurrency :: !Currency
  , forall (s :: Nat). Money s -> Quantity s
moneyQuantity :: !(Quantity s)
  }
  deriving (Money s -> Money s -> Bool
forall (s :: Nat). Money s -> Money s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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 (s :: Nat) x. Rep (Money s) x -> Money s
forall (s :: Nat) x. Money s -> Rep (Money s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (s :: Nat) x. Rep (Money s) x -> Money s
$cfrom :: forall (s :: Nat) x. Money s -> Rep (Money s) x
Generic, Money s -> Money s -> Bool
Money s -> Money s -> Ordering
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
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
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
Ord, Int -> Money s -> ShowS
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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 = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON 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 = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"money"
  toEncoding :: Money s -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding 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) = forall (m :: * -> *) (s :: Nat).
(Monetary m, HasCallStack, KnownNat s) =>
Currency -> Money s -> m (Money s)
convertM Currency
ccyN (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 :: forall (m :: * -> *) (s :: Nat) (k :: Nat).
(HasCallStack, MonadThrow m, KnownNat s, KnownNat k) =>
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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Currency
ccy forall a. Eq a => a -> a -> Bool
/= Currency
ccy1) (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HasCallStack => Currency -> Currency -> MonetaryException
IncompatibleCurrenciesException Currency
ccy Currency
ccy1))
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Day
asof forall a. Ord a => a -> a -> Bool
< Day
date) (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HasCallStack => Day -> Day -> MonetaryException
IncompatibleDatesException Day
date Day
asof))
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Currency
ccy1 forall a. Eq a => a -> a -> Bool
== Currency
ccy2 Bool -> Bool -> Bool
&& forall p x. Refined p x -> x
unrefine Refined Positive (Quantity k)
rate forall a. Eq a => a -> a -> Bool
/= Quantity k
1) (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (forall (s :: Nat).
(HasCallStack, KnownNat s) =>
FxQuote s -> MonetaryException
InconsistentFxQuoteException FxQuote k
quote))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (s :: Nat). Day -> Currency -> Quantity s -> Money s
Money Day
asof Currency
ccy2 (forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
times Quantity s
qty (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