Skip to content

Commit

Permalink
refactor: revisit Haspara.FxQuote module, add new definitions
Browse files Browse the repository at this point in the history
  • Loading branch information
@vst
vst committed Mar 12, 2022
1 parent 99ad657 commit 10bcc0f
Showing 1 changed file with 99 additions and 19 deletions.
118 changes: 99 additions & 19 deletions src/Haspara/FxQuote.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
module Haspara.FxQuote where

import Control.Monad.Except (MonadError(throwError))
import Data.Foldable (foldl')
import qualified Data.Map.Strict as SM
import Data.Scientific (Scientific)
import qualified Data.Text as T
Expand All @@ -29,8 +30,6 @@ import Refined (Positive, Refined, refineError)
-- 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.
Expand All @@ -46,19 +45,19 @@ data FxQuote (s :: Nat) = MkFxQuote
-- 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
-- >>> 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 (read "2021-12-31") "EUR" "USD" (-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
=> Day -- ^ Date of the FX quotation.
-> Currency -- ^ Base currency (from) of the FX quotation.
=> 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 date ccy1 ccy2 rate =
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
Expand All @@ -68,43 +67,53 @@ mkFxQuoteError date ccy1 ccy2 rate =
--
-- 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
-- >>> 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 (read "2021-12-31") "EUR" "USD" (-1.16)
-- >>> mkFxQuoteFail @Maybe @2 "EUR" "USD" (read "2021-12-31") (-1.16)
-- Nothing
mkFxQuoteFail
:: MonadFail m
=> KnownNat s
=> Day -- ^ Date of the FX quotation.
-> Currency -- ^ Base currency (from) of the FX quotation.
=> 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 date ccy1 ccy2 =
either (fail . T.unpack) pure . mkFxQuoteError date ccy1 ccy2
mkFxQuoteFail ccy1 ccy2 date =
either (fail . T.unpack) pure . mkFxQuoteError ccy1 ccy2 date


-- | Unsafe 'FxQuote' constructor that 'error's if it fails.
--
-- >>> mkFxQuoteUnsafe @2 (read "2021-12-31") "EUR" "USD" 1.16
-- >>> mkFxQuoteUnsafe @2 "EUR" "USD" (read "2021-12-31") 1.16
-- MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16}
-- >>> mkFxQuoteUnsafe @2 (read "2021-12-31") "EUR" "USD" (-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
=> Day -- ^ Date of the FX quotation.
-> Currency -- ^ Base currency (from) of the FX quotation.
=> 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 date ccy1 ccy2 =
either (error . T.unpack) id . mkFxQuoteError date ccy1 ccy2
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
Expand All @@ -119,6 +128,7 @@ data FxQuotePairDatabase (n :: Nat) = FxQuotePairDatabase
, fxQuotePairDatabaseSince :: !Day
, fxQuotePairDatabaseUntil :: !Day
}
deriving Show


-- | Attempts to find and return the FX quotation for a given 'CurrencyPair' as
Expand All @@ -140,3 +150,73 @@ findFxQuoteAux date db
| 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
}

0 comments on commit 10bcc0f

Please sign in to comment.