{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
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)
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
(Money s -> Money s -> Bool)
-> (Money s -> Money s -> Bool) -> Eq (Money s)
forall (s :: Nat). Money s -> Money s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, (forall x. Money s -> Rep (Money s) x)
-> (forall x. Rep (Money s) x -> Money s) -> Generic (Money s)
forall (s :: Nat) x. Rep (Money s) x -> Money s
forall (s :: Nat) x. Money s -> Rep (Money s) x
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
$cfrom :: forall (s :: Nat) x. Money s -> Rep (Money s) x
from :: forall x. Money s -> Rep (Money s) x
$cto :: forall (s :: Nat) x. Rep (Money s) x -> Money s
to :: forall x. Rep (Money s) x -> Money s
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 (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
$ccompare :: forall (s :: Nat). Money s -> Money s -> Ordering
compare :: Money s -> Money s -> Ordering
$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
>= :: Money s -> Money s -> Bool
$cmax :: forall (s :: Nat). Money s -> Money s -> Money s
max :: Money s -> Money s -> Money s
$cmin :: forall (s :: Nat). Money s -> Money s -> Money s
min :: Money s -> Money s -> 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 (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
$cshowsPrec :: forall (s :: Nat). KnownNat s => Int -> Money s -> ShowS
showsPrec :: Int -> Money s -> ShowS
$cshow :: forall (s :: Nat). KnownNat s => Money s -> String
show :: Money s -> String
$cshowList :: forall (s :: Nat). KnownNat s => [Money s] -> ShowS
showList :: [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"
toEncoding :: Money s -> Encoding
toEncoding = Options -> Money s -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> Money s -> Encoding) -> Options -> Money s -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"money"
class MonadThrow m => Monetary m where
convertM
:: HasCallStack
=> KnownNat s
=> Currency
-> Money s
-> m (Money s)
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 (s :: Nat).
(HasCallStack, KnownNat s) =>
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)
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
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 e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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 e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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 {k} (p :: k) 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 e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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 a. a -> m a
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 {k} (p :: k) x. Refined p x -> x
unrefine Refined Positive (Quantity k)
rate)))
data MonetaryException where
IncompatibleCurrenciesException
:: HasCallStack
=> Currency
-> Currency
-> MonetaryException
IncompatibleDatesException
:: HasCallStack
=> Day
-> Day
-> MonetaryException
InconsistentFxQuoteException
:: forall (s :: Nat)
. (HasCallStack, KnownNat s)
=> FxQuote s
-> MonetaryException
deriving instance Show MonetaryException
instance Exception MonetaryException