{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides definitions for modeling and working with foreign
-- exchange (FX) rate quotations.
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


-- | 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
  { forall (s :: Nat). FxQuote s -> CurrencyPair
fxQuotePair :: !CurrencyPair
  -- ^ Currency pair of the FX rate.
  , forall (s :: Nat). FxQuote s -> Day
fxQuoteDate :: !Day
  -- ^ Actual date of the FX rate.
  , forall (s :: Nat). 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 (s :: Nat). FxQuote s -> FxQuote s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, (forall x. FxQuote s -> Rep (FxQuote s) x)
-> (forall x. Rep (FxQuote s) x -> FxQuote s)
-> Generic (FxQuote s)
forall (s :: Nat) x. Rep (FxQuote s) x -> FxQuote s
forall (s :: Nat) x. FxQuote s -> Rep (FxQuote s) x
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
$cfrom :: forall (s :: Nat) x. FxQuote s -> Rep (FxQuote s) x
from :: forall x. FxQuote s -> Rep (FxQuote s) x
$cto :: forall (s :: Nat) x. Rep (FxQuote s) x -> FxQuote s
to :: forall x. Rep (FxQuote s) x -> FxQuote s
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 (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
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). FxQuote s -> FxQuote s -> Ordering
compare :: FxQuote s -> FxQuote s -> Ordering
$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
>= :: FxQuote s -> FxQuote s -> Bool
$cmax :: forall (s :: Nat). FxQuote s -> FxQuote s -> FxQuote s
max :: FxQuote s -> FxQuote s -> FxQuote s
$cmin :: forall (s :: Nat). FxQuote s -> FxQuote s -> FxQuote s
min :: FxQuote s -> FxQuote s -> 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 (s :: Nat). KnownNat s => Int -> FxQuote s -> ShowS
forall (s :: Nat). KnownNat s => [FxQuote s] -> ShowS
forall (s :: Nat). KnownNat s => FxQuote s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (s :: Nat). KnownNat s => Int -> FxQuote s -> ShowS
showsPrec :: Int -> FxQuote s -> ShowS
$cshow :: forall (s :: Nat). KnownNat s => FxQuote s -> String
show :: FxQuote s -> String
$cshowList :: forall (s :: Nat). KnownNat s => [FxQuote s] -> ShowS
showList :: [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"
  toEncoding :: FxQuote s -> Encoding
toEncoding = Options -> FxQuote s -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> FxQuote s -> Encoding)
-> Options -> FxQuote s -> Encoding
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.
--
-- >>> :set -XTypeApplications
-- >>> 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 :: forall (m :: * -> *) (s :: Nat).
(MonadError Text m, KnownNat s) =>
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 a. Text -> m a
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 a. a -> m a
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 a. a -> Either Text a
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 {k} (p :: k) 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 a. a -> Either Text a
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.
--
-- >>> :set -XTypeApplications
-- >>> 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 :: forall (m :: * -> *) (s :: Nat).
(MonadFail m, KnownNat s) =>
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 a. String -> m a
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 a. a -> m a
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.
--
-- >>> :set -XTypeApplications
-- >>> 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 :: forall (s :: Nat).
KnownNat s =>
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
--
-- >>> :set -XTypeApplications
-- >>> 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
  { forall (n :: Nat). FxQuotePairDatabase n -> CurrencyPair
fxQuotePairDatabasePair :: !CurrencyPair
  , forall (n :: Nat). FxQuotePairDatabase n -> Map Day (FxQuote n)
fxQuotePairDatabaseTable :: !(SM.Map Day (FxQuote n))
  , forall (n :: Nat). FxQuotePairDatabase n -> Day
fxQuotePairDatabaseSince :: !Day
  , forall (n :: Nat). 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 (n :: Nat).
KnownNat n =>
Int -> FxQuotePairDatabase n -> ShowS
forall (n :: Nat). KnownNat n => [FxQuotePairDatabase n] -> ShowS
forall (n :: Nat). KnownNat n => FxQuotePairDatabase n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (n :: Nat).
KnownNat n =>
Int -> FxQuotePairDatabase n -> ShowS
showsPrec :: Int -> FxQuotePairDatabase n -> ShowS
$cshow :: forall (n :: Nat). KnownNat n => FxQuotePairDatabase n -> String
show :: FxQuotePairDatabase n -> String
$cshowList :: forall (n :: Nat). KnownNat n => [FxQuotePairDatabase n] -> ShowS
showList :: [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 :: forall (n :: Nat).
KnownNat n =>
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 :: forall (n :: Nat).
KnownNat n =>
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.
--
-- >>> :set -XTypeApplications
-- >>> emptyFxQuoteDatabase @8
-- fromList []
emptyFxQuoteDatabase
  :: KnownNat n
  => FxQuoteDatabase n
emptyFxQuoteDatabase :: forall (n :: Nat). KnownNat n => FxQuoteDatabase n
emptyFxQuoteDatabase = Map CurrencyPair (FxQuotePairDatabase n)
forall k a. Map k a
SM.empty


-- | Adds a list of FX rate quotations to the given database.
--
-- >>> :set -XTypeApplications
-- >>> 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 :: forall (n :: Nat).
KnownNat n =>
[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 b a. (b -> a -> b) -> b -> [a] -> b
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 :: forall (n :: Nat).
KnownNat n =>
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


-- | Initializes FX quote pair database with the given FX quote.
initFxQuotePairDatabase
  :: KnownNat n
  => FxQuote n
  -> FxQuotePairDatabase n
initFxQuotePairDatabase :: forall (n :: Nat). KnownNat n => FxQuote n -> FxQuotePairDatabase n
initFxQuotePairDatabase quote :: FxQuote n
quote@(MkFxQuote CurrencyPair
pair Day
date Refined Positive (Quantity 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 :: forall (n :: Nat).
KnownNat n =>
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 = SM.insert date quote (fxQuotePairDatabaseTable before)
    , fxQuotePairDatabaseSince = min (fxQuotePairDatabaseSince before) date
    , fxQuotePairDatabaseUntil = max (fxQuotePairDatabaseUntil before) date
    }