-- | This module provides definitions for modeling and working with foreign
-- exchange (FX) rate quotations.

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

module Haspara.FxQuote where

import           Control.Monad.Except (MonadError(throwError))
import qualified Data.Map.Strict      as SM
import           Data.Scientific      (Scientific)
import qualified Data.Text            as T
import           Data.Time            (Day, addDays)
import qualified Deriving.Aeson.Stock as DAS
import           GHC.TypeLits         (KnownNat, Nat)
import           Haspara.Currency     (Currency, CurrencyPair(CurrencyPair))
import           Haspara.Quantity     (Quantity(..), mkQuantity)
import           Refined              (Positive, Refined, refineError)


-- * FX Rate Quotation
-- $fxRateQuotation


-- | Type encoding for FX rate quotations with fixed precision.
--
-- An FX rate quotation is a 3-tuple of:
--
-- 1. a currency pair the rate is quoted for, and
-- 2. a date that the quotation is effective as of,
-- 3. a (positive) rate as the value of the quotation.
--
-- >>>
data FxQuote (s :: Nat) = MkFxQuote
  { FxQuote s -> CurrencyPair
fxQuotePair :: !CurrencyPair  -- ^ Currency pair of the FX rate.
  , FxQuote s -> Day
fxQuoteDate :: !Day  -- ^ Actual date of the FX rate.
  , FxQuote s -> Refined Positive (Quantity s)
fxQuoteRate :: !(Refined Positive (Quantity s))  -- ^ (Positive) rate value of the FX rate.
  }
  deriving (FxQuote s -> FxQuote s -> Bool
(FxQuote s -> FxQuote s -> Bool)
-> (FxQuote s -> FxQuote s -> Bool) -> Eq (FxQuote s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
/= :: FxQuote s -> FxQuote s -> Bool
$c/= :: forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
== :: FxQuote s -> FxQuote s -> Bool
$c== :: forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
Eq, (forall x. FxQuote s -> Rep (FxQuote s) x)
-> (forall x. Rep (FxQuote s) x -> FxQuote s)
-> Generic (FxQuote s)
forall x. Rep (FxQuote s) x -> FxQuote s
forall x. FxQuote s -> Rep (FxQuote s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Nat) x. Rep (FxQuote s) x -> FxQuote s
forall (s :: Nat) x. FxQuote s -> Rep (FxQuote s) x
$cto :: forall (s :: Nat) x. Rep (FxQuote s) x -> FxQuote s
$cfrom :: forall (s :: Nat) x. FxQuote s -> Rep (FxQuote s) x
DAS.Generic, Eq (FxQuote s)
Eq (FxQuote s)
-> (FxQuote s -> FxQuote s -> Ordering)
-> (FxQuote s -> FxQuote s -> Bool)
-> (FxQuote s -> FxQuote s -> Bool)
-> (FxQuote s -> FxQuote s -> Bool)
-> (FxQuote s -> FxQuote s -> Bool)
-> (FxQuote s -> FxQuote s -> FxQuote s)
-> (FxQuote s -> FxQuote s -> FxQuote s)
-> Ord (FxQuote s)
FxQuote s -> FxQuote s -> Bool
FxQuote s -> FxQuote s -> Ordering
FxQuote s -> FxQuote s -> FxQuote 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 (FxQuote s)
forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
forall (s :: Nat). FxQuote s -> FxQuote s -> Ordering
forall (s :: Nat). FxQuote s -> FxQuote s -> FxQuote s
min :: FxQuote s -> FxQuote s -> FxQuote s
$cmin :: forall (s :: Nat). FxQuote s -> FxQuote s -> FxQuote s
max :: FxQuote s -> FxQuote s -> FxQuote s
$cmax :: forall (s :: Nat). FxQuote s -> FxQuote s -> FxQuote s
>= :: FxQuote s -> FxQuote s -> Bool
$c>= :: forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
> :: FxQuote s -> FxQuote s -> Bool
$c> :: forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
<= :: FxQuote s -> FxQuote s -> Bool
$c<= :: forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
< :: FxQuote s -> FxQuote s -> Bool
$c< :: forall (s :: Nat). FxQuote s -> FxQuote s -> Bool
compare :: FxQuote s -> FxQuote s -> Ordering
$ccompare :: forall (s :: Nat). FxQuote s -> FxQuote s -> Ordering
$cp1Ord :: forall (s :: Nat). Eq (FxQuote s)
Ord, Int -> FxQuote s -> ShowS
[FxQuote s] -> ShowS
FxQuote s -> String
(Int -> FxQuote s -> ShowS)
-> (FxQuote s -> String)
-> ([FxQuote s] -> ShowS)
-> Show (FxQuote s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Nat). KnownNat s => Int -> FxQuote s -> ShowS
forall (s :: Nat). KnownNat s => [FxQuote s] -> ShowS
forall (s :: Nat). KnownNat s => FxQuote s -> String
showList :: [FxQuote s] -> ShowS
$cshowList :: forall (s :: Nat). KnownNat s => [FxQuote s] -> ShowS
show :: FxQuote s -> String
$cshow :: forall (s :: Nat). KnownNat s => FxQuote s -> String
showsPrec :: Int -> FxQuote s -> ShowS
$cshowsPrec :: forall (s :: Nat). KnownNat s => Int -> FxQuote s -> ShowS
Show)
  deriving (Value -> Parser [FxQuote s]
Value -> Parser (FxQuote s)
(Value -> Parser (FxQuote s))
-> (Value -> Parser [FxQuote s]) -> FromJSON (FxQuote s)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (s :: Nat). KnownNat s => Value -> Parser [FxQuote s]
forall (s :: Nat). KnownNat s => Value -> Parser (FxQuote s)
parseJSONList :: Value -> Parser [FxQuote s]
$cparseJSONList :: forall (s :: Nat). KnownNat s => Value -> Parser [FxQuote s]
parseJSON :: Value -> Parser (FxQuote s)
$cparseJSON :: forall (s :: Nat). KnownNat s => Value -> Parser (FxQuote s)
DAS.FromJSON, [FxQuote s] -> Encoding
[FxQuote s] -> Value
FxQuote s -> Encoding
FxQuote s -> Value
(FxQuote s -> Value)
-> (FxQuote s -> Encoding)
-> ([FxQuote s] -> Value)
-> ([FxQuote s] -> Encoding)
-> ToJSON (FxQuote s)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (s :: Nat). KnownNat s => [FxQuote s] -> Encoding
forall (s :: Nat). KnownNat s => [FxQuote s] -> Value
forall (s :: Nat). KnownNat s => FxQuote s -> Encoding
forall (s :: Nat). KnownNat s => FxQuote s -> Value
toEncodingList :: [FxQuote s] -> Encoding
$ctoEncodingList :: forall (s :: Nat). KnownNat s => [FxQuote s] -> Encoding
toJSONList :: [FxQuote s] -> Value
$ctoJSONList :: forall (s :: Nat). KnownNat s => [FxQuote s] -> Value
toEncoding :: FxQuote s -> Encoding
$ctoEncoding :: forall (s :: Nat). KnownNat s => FxQuote s -> Encoding
toJSON :: FxQuote s -> Value
$ctoJSON :: forall (s :: Nat). KnownNat s => FxQuote s -> Value
DAS.ToJSON) via DAS.PrefixedSnake "fxQuote" (FxQuote s)


-- | Smart constructor for 'FxQuote' values within @'MonadError' 'T.Text'@
-- context.
--
-- The rate is expected to be a positive value. If it is not, the function will
-- throw an error.
--
-- >>> mkFxQuoteError @(Either _) @2 (read "2021-12-31") "EUR" "USD" 1.16
-- Right (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16})
-- >>> mkFxQuoteError @(Either _) @2 (read "2021-12-31") "EUR" "USD" (-1.16)
-- Left "Can not create FX Rate. Error was:   The predicate (GreaterThan 0) failed with the message: Value is not greater than 0\n"
mkFxQuoteError
  :: MonadError T.Text m
  => KnownNat s
  => Day         -- ^ Date of the FX quotation.
  -> Currency    -- ^ Base currency (from) of the FX quotation.
  -> Currency    -- ^ Quote currency (to) of the FX quotation.
  -> Scientific  -- ^ FX quotation rate, expected to be positive.
  -> m (FxQuote s)
mkFxQuoteError :: Day -> Currency -> Currency -> Scientific -> m (FxQuote s)
mkFxQuoteError Day
date Currency
ccy1 Currency
ccy2 Scientific
rate =
  (Text -> m (FxQuote s))
-> (FxQuote s -> m (FxQuote s))
-> Either Text (FxQuote s)
-> m (FxQuote s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m (FxQuote s)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m (FxQuote s)) -> (Text -> Text) -> Text -> m (FxQuote s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"Can not create FX Rate. Error was: ") FxQuote s -> m (FxQuote s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (FxQuote s) -> m (FxQuote s))
-> Either Text (FxQuote s) -> m (FxQuote s)
forall a b. (a -> b) -> a -> b
$ do
    Refined Positive (Quantity s)
pval <- (RefineException -> Either Text (Refined Positive (Quantity s)))
-> (Refined Positive (Quantity s)
    -> Either Text (Refined Positive (Quantity s)))
-> Either RefineException (Refined Positive (Quantity s))
-> Either Text (Refined Positive (Quantity s))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Either Text (Refined Positive (Quantity s))
forall a b. a -> Either a b
Left (Text -> Either Text (Refined Positive (Quantity s)))
-> (RefineException -> Text)
-> RefineException
-> Either Text (Refined Positive (Quantity s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (RefineException -> String) -> RefineException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefineException -> String
forall a. Show a => a -> String
show) Refined Positive (Quantity s)
-> Either Text (Refined Positive (Quantity s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RefineException (Refined Positive (Quantity s))
 -> Either Text (Refined Positive (Quantity s)))
-> Either RefineException (Refined Positive (Quantity s))
-> Either Text (Refined Positive (Quantity s))
forall a b. (a -> b) -> a -> b
$ Quantity s
-> Either RefineException (Refined Positive (Quantity s))
forall p x (m :: * -> *).
(Predicate p x, MonadError RefineException m) =>
x -> m (Refined p x)
refineError (Scientific -> Quantity s
forall (s :: Nat). KnownNat s => Scientific -> Quantity s
mkQuantity Scientific
rate)
    FxQuote s -> Either Text (FxQuote s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FxQuote s -> Either Text (FxQuote s))
-> FxQuote s -> Either Text (FxQuote s)
forall a b. (a -> b) -> a -> b
$ CurrencyPair -> Day -> Refined Positive (Quantity s) -> FxQuote s
forall (s :: Nat).
CurrencyPair -> Day -> Refined Positive (Quantity s) -> FxQuote s
MkFxQuote (Currency -> Currency -> CurrencyPair
CurrencyPair Currency
ccy1 Currency
ccy2) Day
date Refined Positive (Quantity s)
pval


-- | Smart constructor for 'FxQuote' values within 'MonadFail' context.
--
-- The rate is expected to be a positive value. If it is not, the function will
-- fail.
-- >>> mkFxQuoteFail @Maybe @2 (read "2021-12-31") "EUR" "USD" 1.16
-- Just (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16})
-- >>> mkFxQuoteFail @Maybe @2 (read "2021-12-31") "EUR" "USD" (-1.16)
-- Nothing
mkFxQuoteFail
  :: MonadFail m
  => KnownNat s
  => Day         -- ^ Date of the FX quotation.
  -> Currency    -- ^ Base currency (from) of the FX quotation.
  -> Currency    -- ^ Quote currency (to) of the FX quotation.
  -> Scientific  -- ^ FX quotation rate, expected to be positive.
  -> m (FxQuote s)
mkFxQuoteFail :: Day -> Currency -> Currency -> Scientific -> m (FxQuote s)
mkFxQuoteFail Day
date Currency
ccy1 Currency
ccy2 =
  (Text -> m (FxQuote s))
-> (FxQuote s -> m (FxQuote s))
-> Either Text (FxQuote s)
-> m (FxQuote s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m (FxQuote s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (FxQuote s))
-> (Text -> String) -> Text -> m (FxQuote s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) FxQuote s -> m (FxQuote s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (FxQuote s) -> m (FxQuote s))
-> (Scientific -> Either Text (FxQuote s))
-> Scientific
-> m (FxQuote s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day
-> Currency -> Currency -> Scientific -> Either Text (FxQuote s)
forall (m :: * -> *) (s :: Nat).
(MonadError Text m, KnownNat s) =>
Day -> Currency -> Currency -> Scientific -> m (FxQuote s)
mkFxQuoteError Day
date Currency
ccy1 Currency
ccy2


-- | Unsafe 'FxQuote' constructor that 'error's if it fails.
--
-- >>> mkFxQuoteUnsafe @2 (read "2021-12-31") "EUR" "USD" 1.16
-- MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16}
-- >>> mkFxQuoteUnsafe @2 (read "2021-12-31") "EUR" "USD" (-1.16)
-- ...
-- ...Can not create FX Rate. Error was:   The predicate (GreaterThan 0) failed with the message: Value is not greater than 0
-- ...
mkFxQuoteUnsafe
  :: KnownNat s
  => Day         -- ^ Date of the FX quotation.
  -> Currency    -- ^ Base currency (from) of the FX quotation.
  -> Currency    -- ^ Quote currency (to) of the FX quotation.
  -> Scientific  -- ^ FX quotation rate, expected to be positive.
  -> FxQuote s
mkFxQuoteUnsafe :: Day -> Currency -> Currency -> Scientific -> FxQuote s
mkFxQuoteUnsafe Day
date Currency
ccy1 Currency
ccy2 =
  (Text -> FxQuote s)
-> (FxQuote s -> FxQuote s) -> Either Text (FxQuote s) -> FxQuote s
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> FxQuote s
forall a. HasCallStack => String -> a
error (String -> FxQuote s) -> (Text -> String) -> Text -> FxQuote s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) FxQuote s -> FxQuote s
forall a. a -> a
id (Either Text (FxQuote s) -> FxQuote s)
-> (Scientific -> Either Text (FxQuote s))
-> Scientific
-> FxQuote s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day
-> Currency -> Currency -> Scientific -> Either Text (FxQuote s)
forall (m :: * -> *) (s :: Nat).
(MonadError Text m, KnownNat s) =>
Day -> Currency -> Currency -> Scientific -> m (FxQuote s)
mkFxQuoteError Day
date Currency
ccy1 Currency
ccy2


-- * FX Rate Quotation Database
-- $fxRateQuotationDatabase


-- | Type encoding for a dictionary-based FX rate quotation database for various
-- 'CurrencyPair' values.
type FxQuoteDatabase (n :: Nat) = SM.Map CurrencyPair (FxQuotePairDatabase n)


-- | Type encoding for FX rate quotation database for a 'CurrencyPair'.
data FxQuotePairDatabase (n :: Nat) = FxQuotePairDatabase
  { FxQuotePairDatabase n -> CurrencyPair
fxQuotePairDatabasePair  :: !CurrencyPair
  , FxQuotePairDatabase n -> Map Day (FxQuote n)
fxQuotePairDatabaseTable :: !(SM.Map Day (FxQuote n))
  , FxQuotePairDatabase n -> Day
fxQuotePairDatabaseSince :: !Day
  , FxQuotePairDatabase n -> Day
fxQuotePairDatabaseUntil :: !Day
  }


-- | Attempts to find and return the FX quotation for a given 'CurrencyPair' as
-- of a give 'Day' in a given 'FxQuoteDatabase'.
findFxQuote
  :: KnownNat n
  => FxQuoteDatabase n  -- ^ FX quotation database to perform the lookup on.
  -> CurrencyPair       -- ^ Currency pair we are looking for the quotation for.
  -> Day                -- ^ Date the quotation we look for is valid as of.
  -> Maybe (FxQuote n)
findFxQuote :: FxQuoteDatabase n -> CurrencyPair -> Day -> Maybe (FxQuote n)
findFxQuote FxQuoteDatabase n
db CurrencyPair
pair Day
date = CurrencyPair -> FxQuoteDatabase n -> Maybe (FxQuotePairDatabase n)
forall k a. Ord k => k -> Map k a -> Maybe a
SM.lookup CurrencyPair
pair FxQuoteDatabase n
db Maybe (FxQuotePairDatabase n)
-> (FxQuotePairDatabase n -> Maybe (FxQuote n))
-> Maybe (FxQuote n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Day -> FxQuotePairDatabase n -> Maybe (FxQuote n)
forall (n :: Nat).
KnownNat n =>
Day -> FxQuotePairDatabase n -> Maybe (FxQuote n)
findFxQuoteAux Day
date


-- | Attempts to find and return the FX quotation as of a give 'Day' in a given
-- 'FxQuotePairDatabase'.
findFxQuoteAux :: KnownNat n => Day -> FxQuotePairDatabase n -> Maybe (FxQuote n)
findFxQuoteAux :: Day -> FxQuotePairDatabase n -> Maybe (FxQuote n)
findFxQuoteAux Day
date FxQuotePairDatabase n
db
  | Day
date Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< FxQuotePairDatabase n -> Day
forall (n :: Nat). FxQuotePairDatabase n -> Day
fxQuotePairDatabaseSince FxQuotePairDatabase n
db = Maybe (FxQuote n)
forall a. Maybe a
Nothing
  | Bool
otherwise = case Day -> Map Day (FxQuote n) -> Maybe (FxQuote n)
forall k a. Ord k => k -> Map k a -> Maybe a
SM.lookup Day
date (FxQuotePairDatabase n -> Map Day (FxQuote n)
forall (n :: Nat). FxQuotePairDatabase n -> Map Day (FxQuote n)
fxQuotePairDatabaseTable FxQuotePairDatabase n
db) of
      Maybe (FxQuote n)
Nothing -> Day -> FxQuotePairDatabase n -> Maybe (FxQuote n)
forall (n :: Nat).
KnownNat n =>
Day -> FxQuotePairDatabase n -> Maybe (FxQuote n)
findFxQuoteAux (Integer -> Day -> Day
addDays (-Integer
1) Day
date) FxQuotePairDatabase n
db
      Just FxQuote n
fx -> FxQuote n -> Maybe (FxQuote n)
forall a. a -> Maybe a
Just FxQuote n
fx