FxQuote.hs

-- | 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.Aeson             as Aeson
import           Data.Foldable          (foldl')
import qualified Data.Map.Strict        as SM
import           Data.Scientific        (Scientific)
import qualified Data.Text              as T
import           Data.Time              (Day, addDays)
import           GHC.Generics           (Generic)
import           GHC.TypeLits           (KnownNat, Nat)
import           Haspara.Currency       (Currency, CurrencyPair(CurrencyPair))
import           Haspara.Internal.Aeson (commonAesonOptions)
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
  { fxQuotePair :: !CurrencyPair  -- ^ Currency pair of the FX rate.
  , fxQuoteDate :: !Day  -- ^ Actual date of the FX rate.
  , fxQuoteRate :: !(Refined Positive (Quantity s))  -- ^ (Positive) rate value of the FX rate.
  }
  deriving (Eq, Generic, Ord, Show)


instance KnownNat s => Aeson.FromJSON (FxQuote s) where
  parseJSON = Aeson.genericParseJSON $ commonAesonOptions "fxQuote"


instance KnownNat s => Aeson.ToJSON (FxQuote s) where
  toJSON = Aeson.genericToJSON $ commonAesonOptions "fxQuote"


-- | 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 "EUR" "USD" (read "2021-12-31") 1.16
-- Right (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16})
-- >>> mkFxQuoteError @(Either _) @2 "EUR" "USD" (read "2021-12-31") (-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
  => Currency    -- ^ Base currency (from) of the FX quotation.
  -> Currency    -- ^ Quote currency (to) of the FX quotation.
  -> Day         -- ^ Date of the FX quotation.
  -> Scientific  -- ^ FX quotation rate, expected to be positive.
  -> m (FxQuote s)
mkFxQuoteError ccy1 ccy2 date rate =
  either (throwError . (<>) "Can not create FX Rate. Error was: ") pure $ do
    pval <- either (Left . T.pack . show) pure $ refineError (mkQuantity rate)
    pure $ MkFxQuote (CurrencyPair ccy1 ccy2) date 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 "EUR" "USD" (read "2021-12-31") 1.16
-- Just (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16})
-- >>> mkFxQuoteFail @Maybe @2 "EUR" "USD" (read "2021-12-31") (-1.16)
-- Nothing
mkFxQuoteFail
  :: MonadFail m
  => KnownNat s
  => Currency    -- ^ Base currency (from) of the FX quotation.
  -> Currency    -- ^ Quote currency (to) of the FX quotation.
  -> Day         -- ^ Date of the FX quotation.
  -> Scientific  -- ^ FX quotation rate, expected to be positive.
  -> m (FxQuote s)
mkFxQuoteFail ccy1 ccy2 date =
  either (fail . T.unpack) pure . mkFxQuoteError ccy1 ccy2 date


-- | Unsafe 'FxQuote' constructor that 'error's if it fails.
--
-- >>> mkFxQuoteUnsafe @2 "EUR" "USD" (read "2021-12-31") 1.16
-- MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16}
-- >>> mkFxQuoteUnsafe @2 "EUR" "USD" (read "2021-12-31") (-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
  => Currency    -- ^ Base currency (from) of the FX quotation.
  -> Currency    -- ^ Quote currency (to) of the FX quotation.
  -> Day         -- ^ Date of the FX quotation.
  -> Scientific  -- ^ FX quotation rate, expected to be positive.
  -> FxQuote s
mkFxQuoteUnsafe ccy1 ccy2 date =
  either (error . T.unpack) id . mkFxQuoteError ccy1 ccy2 date


-- * FX Rate Quotation Database
-- $fxRateQuotationDatabase
--
-- >>> let database = addFxQuotes [mkFxQuoteUnsafe @8 "EUR" "USD" (read "2021-12-31") 1.13, mkFxQuoteUnsafe @8 "EUR" "TRY" (read "2021-12-31") 15.14] emptyFxQuoteDatabase
-- >>> findFxQuote database (CurrencyPair "EUR" "USD") (read "2021-12-31")
-- Just (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.13000000})
-- >>> findFxQuote database (CurrencyPair "EUR" "TRY") (read "2021-12-31")
-- Just (MkFxQuote {fxQuotePair = EUR/TRY, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 15.14000000})
-- >>> findFxQuote database (CurrencyPair "EUR" "TRY") (read "2021-12-30")
-- Nothing
-- >>> findFxQuote database (CurrencyPair "EUR" "TRY") (read "2022-01-01")
-- Just (MkFxQuote {fxQuotePair = EUR/TRY, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 15.14000000})


-- | 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
  { fxQuotePairDatabasePair  :: !CurrencyPair
  , fxQuotePairDatabaseTable :: !(SM.Map Day (FxQuote n))
  , fxQuotePairDatabaseSince :: !Day
  , fxQuotePairDatabaseUntil :: !Day
  }
  deriving Show


-- | 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 db pair date = SM.lookup pair db >>= findFxQuoteAux 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 date db
  | date < fxQuotePairDatabaseSince db = Nothing
  | otherwise = case SM.lookup date (fxQuotePairDatabaseTable db) of
      Nothing -> findFxQuoteAux (addDays (-1) date) db
      Just fx -> Just fx


-- | Returns empty FX rate quotation database.
--
-- >>> emptyFxQuoteDatabase @8
-- fromList []
emptyFxQuoteDatabase
  :: KnownNat n
  => FxQuoteDatabase n
emptyFxQuoteDatabase = SM.empty


-- | Adds a list of FX rate quotations to the given database.
--
-- >>> let database = emptyFxQuoteDatabase @8
-- >>> addFxQuotes [] database
-- fromList []
-- >>> addFxQuotes [mkFxQuoteUnsafe @8 "EUR" "USD" (read "2021-01-31") 1.13] database
-- fromList [(EUR/USD,FxQuotePairDatabase {fxQuotePairDatabasePair = EUR/USD, fxQuotePairDatabaseTable = fromList [(2021-01-31,MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-01-31, fxQuoteRate = Refined 1.13000000})], fxQuotePairDatabaseSince = 2021-01-31, fxQuotePairDatabaseUntil = 2021-01-31})]
-- >>> addFxQuotes [mkFxQuoteUnsafe @8 "EUR" "USD" (read "2021-01-31") 1.13, mkFxQuoteUnsafe @8 "USD" "EUR" (read "2021-01-31") 0.884956] database
-- fromList [(EUR/USD,FxQuotePairDatabase {fxQuotePairDatabasePair = EUR/USD, fxQuotePairDatabaseTable = fromList [(2021-01-31,MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-01-31, fxQuoteRate = Refined 1.13000000})], fxQuotePairDatabaseSince = 2021-01-31, fxQuotePairDatabaseUntil = 2021-01-31}),(USD/EUR,FxQuotePairDatabase {fxQuotePairDatabasePair = USD/EUR, fxQuotePairDatabaseTable = fromList [(2021-01-31,MkFxQuote {fxQuotePair = USD/EUR, fxQuoteDate = 2021-01-31, fxQuoteRate = Refined 0.88495600})], fxQuotePairDatabaseSince = 2021-01-31, fxQuotePairDatabaseUntil = 2021-01-31})]
addFxQuotes
  :: KnownNat n
  => [FxQuote n]
  -> FxQuoteDatabase n
  -> FxQuoteDatabase n
addFxQuotes quotes database = foldl' (flip addFxQuote) database quotes


-- | Adds an FX rate quotation to the given database.
addFxQuote
  :: KnownNat n
  => FxQuote n
  -> FxQuoteDatabase n
  -> FxQuoteDatabase n
addFxQuote quote@(MkFxQuote pair _ _) database = case SM.lookup pair database of
  Nothing  -> SM.insert pair (initFxQuotePairDatabase quote) database
  Just fpd -> SM.insert pair (updateFxQuotePairDatabase quote fpd) database


-- * Internal
-- $internal


-- | Initializes FX quote pair database with the given FX quote.
initFxQuotePairDatabase
  :: KnownNat n
  => FxQuote n
  -> FxQuotePairDatabase n
initFxQuotePairDatabase quote@(MkFxQuote pair date _) =
  FxQuotePairDatabase
    { fxQuotePairDatabasePair  = pair
    , fxQuotePairDatabaseTable = SM.singleton date quote
    , fxQuotePairDatabaseSince = date
    , fxQuotePairDatabaseUntil = date
    }


-- | Updates an existing FX quote pair database with the given FX quote.
updateFxQuotePairDatabase
  :: KnownNat n
  => FxQuote n
  -> FxQuotePairDatabase n
  -> FxQuotePairDatabase n
updateFxQuotePairDatabase quote@(MkFxQuote _ date _) before =
  before
    { fxQuotePairDatabaseTable = SM.insert date quote (fxQuotePairDatabaseTable before)
    , fxQuotePairDatabaseSince = min (fxQuotePairDatabaseSince before) date
    , fxQuotePairDatabaseUntil = max (fxQuotePairDatabaseUntil before) date
    }