-- | 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
  { 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
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)


instance KnownNat s => Aeson.FromJSON (FxQuote s) where
  parseJSON :: Value -> Parser (FxQuote s)
parseJSON = Options -> Value -> Parser (FxQuote s)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser (FxQuote s))
-> Options -> Value -> Parser (FxQuote s)
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"fxQuote"


instance KnownNat s => Aeson.ToJSON (FxQuote s) where
  toJSON :: FxQuote s -> Value
toJSON = Options -> FxQuote s -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> FxQuote s -> Value) -> Options -> FxQuote s -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"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 :: Currency -> Currency -> Day -> Scientific -> m (FxQuote s)
mkFxQuoteError Currency
ccy1 Currency
ccy2 Day
date 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 "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 :: Currency -> Currency -> Day -> Scientific -> m (FxQuote s)
mkFxQuoteFail Currency
ccy1 Currency
ccy2 Day
date =
  (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
. Currency
-> Currency -> Day -> Scientific -> Either Text (FxQuote s)
forall (m :: * -> *) (s :: Nat).
(MonadError Text m, KnownNat s) =>
Currency -> Currency -> Day -> Scientific -> m (FxQuote s)
mkFxQuoteError Currency
ccy1 Currency
ccy2 Day
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 :: Currency -> Currency -> Day -> Scientific -> FxQuote s
mkFxQuoteUnsafe Currency
ccy1 Currency
ccy2 Day
date =
  (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
. Currency
-> Currency -> Day -> Scientific -> Either Text (FxQuote s)
forall (m :: * -> *) (s :: Nat).
(MonadError Text m, KnownNat s) =>
Currency -> Currency -> Day -> Scientific -> m (FxQuote s)
mkFxQuoteError Currency
ccy1 Currency
ccy2 Day
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
  { 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
  }
  deriving Int -> FxQuotePairDatabase n -> ShowS
[FxQuotePairDatabase n] -> ShowS
FxQuotePairDatabase n -> String
(Int -> FxQuotePairDatabase n -> ShowS)
-> (FxQuotePairDatabase n -> String)
-> ([FxQuotePairDatabase n] -> ShowS)
-> Show (FxQuotePairDatabase n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat).
KnownNat n =>
Int -> FxQuotePairDatabase n -> ShowS
forall (n :: Nat). KnownNat n => [FxQuotePairDatabase n] -> ShowS
forall (n :: Nat). KnownNat n => FxQuotePairDatabase n -> String
showList :: [FxQuotePairDatabase n] -> ShowS
$cshowList :: forall (n :: Nat). KnownNat n => [FxQuotePairDatabase n] -> ShowS
show :: FxQuotePairDatabase n -> String
$cshow :: forall (n :: Nat). KnownNat n => FxQuotePairDatabase n -> String
showsPrec :: Int -> FxQuotePairDatabase n -> ShowS
$cshowsPrec :: forall (n :: Nat).
KnownNat n =>
Int -> FxQuotePairDatabase n -> ShowS
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 :: 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


-- | Returns empty FX rate quotation database.
--
-- >>> emptyFxQuoteDatabase @8
-- fromList []
emptyFxQuoteDatabase
  :: KnownNat n
  => FxQuoteDatabase n
emptyFxQuoteDatabase :: FxQuoteDatabase n
emptyFxQuoteDatabase = FxQuoteDatabase n
forall k a. Map k a
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 :: [FxQuote n] -> FxQuoteDatabase n -> FxQuoteDatabase n
addFxQuotes [FxQuote n]
quotes FxQuoteDatabase n
database = (FxQuoteDatabase n -> FxQuote n -> FxQuoteDatabase n)
-> FxQuoteDatabase n -> [FxQuote n] -> FxQuoteDatabase n
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((FxQuote n -> FxQuoteDatabase n -> FxQuoteDatabase n)
-> FxQuoteDatabase n -> FxQuote n -> FxQuoteDatabase n
forall a b c. (a -> b -> c) -> b -> a -> c
flip FxQuote n -> FxQuoteDatabase n -> FxQuoteDatabase n
forall (n :: Nat).
KnownNat n =>
FxQuote n -> FxQuoteDatabase n -> FxQuoteDatabase n
addFxQuote) FxQuoteDatabase n
database [FxQuote n]
quotes


-- | Adds an FX rate quotation to the given database.
addFxQuote
  :: KnownNat n
  => FxQuote n
  -> FxQuoteDatabase n
  -> FxQuoteDatabase n
addFxQuote :: FxQuote n -> FxQuoteDatabase n -> FxQuoteDatabase n
addFxQuote quote :: FxQuote n
quote@(MkFxQuote CurrencyPair
pair Day
_ Refined Positive (Quantity n)
_) FxQuoteDatabase n
database = case CurrencyPair -> FxQuoteDatabase n -> Maybe (FxQuotePairDatabase n)
forall k a. Ord k => k -> Map k a -> Maybe a
SM.lookup CurrencyPair
pair FxQuoteDatabase n
database of
  Maybe (FxQuotePairDatabase n)
Nothing  -> CurrencyPair
-> FxQuotePairDatabase n -> FxQuoteDatabase n -> FxQuoteDatabase n
forall k a. Ord k => k -> a -> Map k a -> Map k a
SM.insert CurrencyPair
pair (FxQuote n -> FxQuotePairDatabase n
forall (n :: Nat). KnownNat n => FxQuote n -> FxQuotePairDatabase n
initFxQuotePairDatabase FxQuote n
quote) FxQuoteDatabase n
database
  Just FxQuotePairDatabase n
fpd -> CurrencyPair
-> FxQuotePairDatabase n -> FxQuoteDatabase n -> FxQuoteDatabase n
forall k a. Ord k => k -> a -> Map k a -> Map k a
SM.insert CurrencyPair
pair (FxQuote n -> FxQuotePairDatabase n -> FxQuotePairDatabase n
forall (n :: Nat).
KnownNat n =>
FxQuote n -> FxQuotePairDatabase n -> FxQuotePairDatabase n
updateFxQuotePairDatabase FxQuote n
quote FxQuotePairDatabase n
fpd) FxQuoteDatabase n
database


-- * Internal
-- $internal


-- | Initializes FX quote pair database with the given FX quote.
initFxQuotePairDatabase
  :: KnownNat n
  => FxQuote n
  -> FxQuotePairDatabase n
initFxQuotePairDatabase :: FxQuote n -> FxQuotePairDatabase n
initFxQuotePairDatabase quote :: FxQuote n
quote@(MkFxQuote CurrencyPair
pair Day
date Refined Positive (Quantity n)
_) =
  FxQuotePairDatabase :: forall (n :: Nat).
CurrencyPair
-> Map Day (FxQuote n) -> Day -> Day -> FxQuotePairDatabase n
FxQuotePairDatabase
    { fxQuotePairDatabasePair :: CurrencyPair
fxQuotePairDatabasePair  = CurrencyPair
pair
    , fxQuotePairDatabaseTable :: Map Day (FxQuote n)
fxQuotePairDatabaseTable = Day -> FxQuote n -> Map Day (FxQuote n)
forall k a. k -> a -> Map k a
SM.singleton Day
date FxQuote n
quote
    , fxQuotePairDatabaseSince :: Day
fxQuotePairDatabaseSince = Day
date
    , fxQuotePairDatabaseUntil :: Day
fxQuotePairDatabaseUntil = Day
date
    }


-- | Updates an existing FX quote pair database with the given FX quote.
updateFxQuotePairDatabase
  :: KnownNat n
  => FxQuote n
  -> FxQuotePairDatabase n
  -> FxQuotePairDatabase n
updateFxQuotePairDatabase :: FxQuote n -> FxQuotePairDatabase n -> FxQuotePairDatabase n
updateFxQuotePairDatabase quote :: FxQuote n
quote@(MkFxQuote CurrencyPair
_ Day
date Refined Positive (Quantity n)
_) FxQuotePairDatabase n
before =
  FxQuotePairDatabase n
before
    { fxQuotePairDatabaseTable :: Map Day (FxQuote n)
fxQuotePairDatabaseTable = Day -> FxQuote n -> Map Day (FxQuote n) -> Map Day (FxQuote n)
forall k a. Ord k => k -> a -> Map k a -> Map k a
SM.insert Day
date FxQuote n
quote (FxQuotePairDatabase n -> Map Day (FxQuote n)
forall (n :: Nat). FxQuotePairDatabase n -> Map Day (FxQuote n)
fxQuotePairDatabaseTable FxQuotePairDatabase n
before)
    , fxQuotePairDatabaseSince :: Day
fxQuotePairDatabaseSince = Day -> Day -> Day
forall a. Ord a => a -> a -> a
min (FxQuotePairDatabase n -> Day
forall (n :: Nat). FxQuotePairDatabase n -> Day
fxQuotePairDatabaseSince FxQuotePairDatabase n
before) Day
date
    , fxQuotePairDatabaseUntil :: Day
fxQuotePairDatabaseUntil = Day -> Day -> Day
forall a. Ord a => a -> a -> a
max (FxQuotePairDatabase n -> Day
forall (n :: Nat). FxQuotePairDatabase n -> Day
fxQuotePairDatabaseUntil FxQuotePairDatabase n
before) Day
date
    }