-- | This module provides internal definitions for modeling and working with FX
-- rates.
--
{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures   #-}

module Haspara.Internal.FXQuote where

import           Control.Monad.Except      (MonadError(throwError), join)
import           Data.Aeson                ((.:), (.=))
import qualified Data.Aeson                as Aeson
import           Data.Scientific           (Scientific)
import           GHC.TypeLits              (KnownNat, Nat)
import           Haspara.Internal.Currency (Currency, CurrencyPair, baseCurrency, currencyPair, quoteCurrency)
import           Haspara.Internal.Date     (Date)
import           Haspara.Internal.Quantity (Quantity(..), quantity)
import           Numeric.Decimal           (toScientificDecimal)
import           Refined                   (Positive, Refined, refineError, unrefine)

-- * FX Rate Data Definition
-- &fXQuoteValue


-- | Type encoding for FX rates.
data FXQuote (s :: Nat) = MkFXQuote
  { -- | Actual date of the FX rate.
    FXQuote s -> Date
fxQuoteDate :: !Date
    -- | Currency pair of the FX rate.
  , FXQuote s -> CurrencyPair
fxQuotePair :: !CurrencyPair
    -- | Rate value of the FX rate.
  , FXQuote s -> Refined Positive (Quantity s)
fxQuoteRate :: !(Refined Positive (Quantity s))
  } 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, 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)


instance (KnownNat s) => Show (FXQuote s) where
  show :: FXQuote s -> String
show (MkFXQuote Date
d CurrencyPair
p Refined Positive (Quantity s)
r) = (String, String, String) -> String
forall a. Show a => a -> String
show (CurrencyPair -> String
forall a. Show a => a -> String
show CurrencyPair
p, Date -> String
forall a. Show a => a -> String
show Date
d, Quantity s -> String
forall a. Show a => a -> String
show (Refined Positive (Quantity s) -> Quantity s
forall p x. Refined p x -> x
unrefine Refined Positive (Quantity s)
r))


-- | 'Aeson.FromJSON' instance for 'Currency'
--
-- >>> :set -XDataKinds
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": 1.35}" :: Either String (FXQuote 2)
-- Right ("USD/SGD","2021-01-01","1.35")
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": 1.354}" :: Either String (FXQuote 2)
-- Right ("USD/SGD","2021-01-01","1.35")
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": 1.355}" :: Either String (FXQuote 2)
-- Right ("USD/SGD","2021-01-01","1.36")
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": 1.356}" :: Either String (FXQuote 2)
-- Right ("USD/SGD","2021-01-01","1.36")
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": 1.364}" :: Either String (FXQuote 2)
-- Right ("USD/SGD","2021-01-01","1.36")
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": 1.365}" :: Either String (FXQuote 2)
-- Right ("USD/SGD","2021-01-01","1.36")
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": 1.366}" :: Either String (FXQuote 2)
-- Right ("USD/SGD","2021-01-01","1.37")
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"USD\", \"rate\": 1.35}" :: Either String (FXQuote 2)
-- Left "Error in $: Can not create FX Rate. Error was: Can not create currency pair from same currencies: USD and USD"
-- >>> Aeson.eitherDecode "{\"date\": \"2021-01-01\", \"ccy1\": \"USD\", \"ccy2\": \"SGD\", \"rate\": -1.35}" :: Either String (FXQuote 2)
-- Left "Error in $: Can not create FX Rate. Error was:   The predicate (GreaterThan 0) failed with the message: Value is not greater than 0\n"
instance (KnownNat s) => Aeson.FromJSON (FXQuote s) where
  parseJSON :: Value -> Parser (FXQuote s)
parseJSON = String
-> (Object -> Parser (FXQuote s)) -> Value -> Parser (FXQuote s)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"FXQuote" ((Object -> Parser (FXQuote s)) -> Value -> Parser (FXQuote s))
-> (Object -> Parser (FXQuote s)) -> Value -> Parser (FXQuote s)
forall a b. (a -> b) -> a -> b
$ \Object
o -> Parser (Parser (FXQuote s)) -> Parser (FXQuote s)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Parser (Parser (FXQuote s)) -> Parser (FXQuote s))
-> Parser (Parser (FXQuote s)) -> Parser (FXQuote s)
forall a b. (a -> b) -> a -> b
$ Date -> Currency -> Currency -> Scientific -> Parser (FXQuote s)
forall (s :: Nat) (m :: * -> *).
(KnownNat s, MonadFail m) =>
Date -> Currency -> Currency -> Scientific -> m (FXQuote s)
fxquoteFail
    (Date -> Currency -> Currency -> Scientific -> Parser (FXQuote s))
-> Parser Date
-> Parser
     (Currency -> Currency -> Scientific -> Parser (FXQuote s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Date
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date"
    Parser (Currency -> Currency -> Scientific -> Parser (FXQuote s))
-> Parser Currency
-> Parser (Currency -> Scientific -> Parser (FXQuote s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Currency
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ccy1"
    Parser (Currency -> Scientific -> Parser (FXQuote s))
-> Parser Currency -> Parser (Scientific -> Parser (FXQuote s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Currency
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ccy2"
    Parser (Scientific -> Parser (FXQuote s))
-> Parser Scientific -> Parser (Parser (FXQuote s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Scientific
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rate"


-- | 'Aeson.ToJSON' instance for 'Currency'
--
-- >>> :set -XDataKinds
-- >>> let rate = fxquoteUnsafe (read "2021-01-01") "USD" "SGD" 1.35 :: FXQuote 2
-- >>> Aeson.encode rate
-- "{\"ccy2\":\"SGD\",\"date\":\"2021-01-01\",\"rate\":1.35,\"ccy1\":\"USD\"}"
instance (KnownNat s) => Aeson.ToJSON (FXQuote s) where
  toJSON :: FXQuote s -> Value
toJSON (MkFXQuote Date
d CurrencyPair
cp Refined Positive (Quantity s)
v) = [Pair] -> Value
Aeson.object
    [ Text
"date" Text -> Date -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Date
d
    , Text
"ccy1" Text -> Currency -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CurrencyPair -> Currency
baseCurrency CurrencyPair
cp
    , Text
"ccy2" Text -> Currency -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CurrencyPair -> Currency
quoteCurrency CurrencyPair
cp
    , Text
"rate" Text -> Scientific -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Decimal RoundHalfEven s Integer -> Scientific
forall p (s :: Nat) r.
(Integral p, KnownNat s) =>
Decimal r s p -> Scientific
toScientificDecimal (Decimal RoundHalfEven s Integer -> Scientific)
-> (Refined Positive (Quantity s)
    -> Decimal RoundHalfEven s Integer)
-> Refined Positive (Quantity s)
-> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity s -> Decimal RoundHalfEven s Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity (Quantity s -> Decimal RoundHalfEven s Integer)
-> (Refined Positive (Quantity s) -> Quantity s)
-> Refined Positive (Quantity s)
-> Decimal RoundHalfEven s Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refined Positive (Quantity s) -> Quantity s
forall p x. Refined p x -> x
unrefine) Refined Positive (Quantity s)
v
    ]


-- * Constructors
-- &constructors


-- | Smart constructor for 'FXQuote' values within 'MonadError' context.
fxquote
  :: (KnownNat s, MonadError String m)
  => Date        -- ^ Date of the FX rate.
  -> Currency    -- ^ First currency (from) of the FX rate.
  -> Currency    -- ^ Second currency (to) of the FX rate.
  -> Scientific  -- ^ FX rate value.
  -> m (FXQuote s)
fxquote :: Date -> Currency -> Currency -> Scientific -> m (FXQuote s)
fxquote Date
d Currency
c1 Currency
c2 Scientific
v = (String -> m (FXQuote s))
-> (FXQuote s -> m (FXQuote s))
-> Either String (FXQuote s)
-> m (FXQuote s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m (FXQuote s)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (FXQuote s)) -> ShowS -> String -> m (FXQuote s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) String
"Can not create FX Rate. Error was: ") FXQuote s -> m (FXQuote s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (FXQuote s) -> m (FXQuote s))
-> Either String (FXQuote s) -> m (FXQuote s)
forall a b. (a -> b) -> a -> b
$ do
  CurrencyPair
pair <- Currency -> Currency -> Either String CurrencyPair
forall (m :: * -> *).
MonadError String m =>
Currency -> Currency -> m CurrencyPair
currencyPair Currency
c1 Currency
c2
  Refined Positive (Quantity s)
pval <- (RefineException -> Either String (Refined Positive (Quantity s)))
-> (Refined Positive (Quantity s)
    -> Either String (Refined Positive (Quantity s)))
-> Either RefineException (Refined Positive (Quantity s))
-> Either String (Refined Positive (Quantity s))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String (Refined Positive (Quantity s))
forall a b. a -> Either a b
Left (String -> Either String (Refined Positive (Quantity s)))
-> (RefineException -> String)
-> RefineException
-> Either String (Refined Positive (Quantity s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefineException -> String
forall a. Show a => a -> String
show) Refined Positive (Quantity s)
-> Either String (Refined Positive (Quantity s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RefineException (Refined Positive (Quantity s))
 -> Either String (Refined Positive (Quantity s)))
-> Either RefineException (Refined Positive (Quantity s))
-> Either String (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
quantity Scientific
v)
  FXQuote s -> Either String (FXQuote s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FXQuote s -> Either String (FXQuote s))
-> FXQuote s -> Either String (FXQuote s)
forall a b. (a -> b) -> a -> b
$ Date -> CurrencyPair -> Refined Positive (Quantity s) -> FXQuote s
forall (s :: Nat).
Date -> CurrencyPair -> Refined Positive (Quantity s) -> FXQuote s
MkFXQuote Date
d CurrencyPair
pair Refined Positive (Quantity s)
pval


-- | Smart constructor for 'FXQuote' values within 'MonadFail' context.
fxquoteFail
  :: (KnownNat s, MonadFail m)
  => Date        -- ^ Date of the FX rate.
  -> Currency    -- ^ First currency (from) of the FX rate.
  -> Currency    -- ^ Second currency (to) of the FX rate.
  -> Scientific  -- ^ FX rate value.
  -> m (FXQuote s)
fxquoteFail :: Date -> Currency -> Currency -> Scientific -> m (FXQuote s)
fxquoteFail Date
d Currency
c1 Currency
c2 = (String -> m (FXQuote s))
-> (FXQuote s -> m (FXQuote s))
-> Either String (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 FXQuote s -> m (FXQuote s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (FXQuote s) -> m (FXQuote s))
-> (Scientific -> Either String (FXQuote s))
-> Scientific
-> m (FXQuote s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date
-> Currency -> Currency -> Scientific -> Either String (FXQuote s)
forall (s :: Nat) (m :: * -> *).
(KnownNat s, MonadError String m) =>
Date -> Currency -> Currency -> Scientific -> m (FXQuote s)
fxquote Date
d Currency
c1 Currency
c2


-- | Unsafe 'FXQuote' constructor that 'error's if it fails.
fxquoteUnsafe
  :: KnownNat s
  => Date        -- ^ Date of the FX rate.
  -> Currency    -- ^ First currency (from) of the FX rate.
  -> Currency    -- ^ Second currency (to) of the FX rate.
  -> Scientific  -- ^ FX rate value.
  -> FXQuote s
fxquoteUnsafe :: Date -> Currency -> Currency -> Scientific -> FXQuote s
fxquoteUnsafe Date
d Currency
c1 Currency
c2 = (String -> FXQuote s)
-> (FXQuote s -> FXQuote s)
-> Either String (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 FXQuote s -> FXQuote s
forall a. a -> a
id (Either String (FXQuote s) -> FXQuote s)
-> (Scientific -> Either String (FXQuote s))
-> Scientific
-> FXQuote s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date
-> Currency -> Currency -> Scientific -> Either String (FXQuote s)
forall (s :: Nat) (m :: * -> *).
(KnownNat s, MonadError String m) =>
Date -> Currency -> Currency -> Scientific -> m (FXQuote s)
fxquote Date
d Currency
c1 Currency
c2