{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

module Hedge
  (RateSwap(..),RateCap(..)
  ,RateSwapType(..),RateSwapBase(..)
  ,accrueIRS,payoutIRS,receiveIRS,receiveRC
  ,CurrencySwap(..),rsRefBalLens,SRT(..),SrtType(..)
  )
  where

import qualified Data.Text as T
import qualified Data.Time as Time
import qualified Data.Map as Map
import GHC.Generics
import Language.Haskell.TH
import Data.Aeson hiding (json)
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Fixed
import Data.Maybe
import qualified Data.DList as DL
import Types
import Util
import Stmt
import DateUtil

import qualified Assumptions as A
import qualified InterestRate as IR
import Control.Lens

import Debug.Trace
debug :: c -> String -> c
debug = (String -> c -> c) -> c -> String -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> c -> c
forall a. String -> a -> a
trace

type SettleDates = DatePattern       -- ^ dates when rates/ex-rates are reseted
type ReceiveAmount = Balance         -- ^ cash to be collect in instrutment
type PayoutAmount = Balance          -- ^ cash to be paid in instrutment

data RateSwapBase = Fixed Balance    -- ^ a fixed balance as notional base 
                  | Base DealStats   -- ^ a referece as notional base
                  | Schedule Ts      -- ^ a predfiend schedule of notional balance
                  deriving(Int -> RateSwapBase -> ShowS
[RateSwapBase] -> ShowS
RateSwapBase -> String
(Int -> RateSwapBase -> ShowS)
-> (RateSwapBase -> String)
-> ([RateSwapBase] -> ShowS)
-> Show RateSwapBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RateSwapBase -> ShowS
showsPrec :: Int -> RateSwapBase -> ShowS
$cshow :: RateSwapBase -> String
show :: RateSwapBase -> String
$cshowList :: [RateSwapBase] -> ShowS
showList :: [RateSwapBase] -> ShowS
Show,(forall x. RateSwapBase -> Rep RateSwapBase x)
-> (forall x. Rep RateSwapBase x -> RateSwapBase)
-> Generic RateSwapBase
forall x. Rep RateSwapBase x -> RateSwapBase
forall x. RateSwapBase -> Rep RateSwapBase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RateSwapBase -> Rep RateSwapBase x
from :: forall x. RateSwapBase -> Rep RateSwapBase x
$cto :: forall x. Rep RateSwapBase x -> RateSwapBase
to :: forall x. Rep RateSwapBase x -> RateSwapBase
Generic,RateSwapBase -> RateSwapBase -> Bool
(RateSwapBase -> RateSwapBase -> Bool)
-> (RateSwapBase -> RateSwapBase -> Bool) -> Eq RateSwapBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RateSwapBase -> RateSwapBase -> Bool
== :: RateSwapBase -> RateSwapBase -> Bool
$c/= :: RateSwapBase -> RateSwapBase -> Bool
/= :: RateSwapBase -> RateSwapBase -> Bool
Eq,Eq RateSwapBase
Eq RateSwapBase =>
(RateSwapBase -> RateSwapBase -> Ordering)
-> (RateSwapBase -> RateSwapBase -> Bool)
-> (RateSwapBase -> RateSwapBase -> Bool)
-> (RateSwapBase -> RateSwapBase -> Bool)
-> (RateSwapBase -> RateSwapBase -> Bool)
-> (RateSwapBase -> RateSwapBase -> RateSwapBase)
-> (RateSwapBase -> RateSwapBase -> RateSwapBase)
-> Ord RateSwapBase
RateSwapBase -> RateSwapBase -> Bool
RateSwapBase -> RateSwapBase -> Ordering
RateSwapBase -> RateSwapBase -> RateSwapBase
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 :: RateSwapBase -> RateSwapBase -> Ordering
compare :: RateSwapBase -> RateSwapBase -> Ordering
$c< :: RateSwapBase -> RateSwapBase -> Bool
< :: RateSwapBase -> RateSwapBase -> Bool
$c<= :: RateSwapBase -> RateSwapBase -> Bool
<= :: RateSwapBase -> RateSwapBase -> Bool
$c> :: RateSwapBase -> RateSwapBase -> Bool
> :: RateSwapBase -> RateSwapBase -> Bool
$c>= :: RateSwapBase -> RateSwapBase -> Bool
>= :: RateSwapBase -> RateSwapBase -> Bool
$cmax :: RateSwapBase -> RateSwapBase -> RateSwapBase
max :: RateSwapBase -> RateSwapBase -> RateSwapBase
$cmin :: RateSwapBase -> RateSwapBase -> RateSwapBase
min :: RateSwapBase -> RateSwapBase -> RateSwapBase
Ord)

data RateSwapType = FloatingToFloating Floater Floater    -- ^ Paying Floating rate and receiving Floating Rate
                  | FloatingToFixed  Floater IRate        -- ^ Paying Floating Rate and receiving Fixed Rate
                  | FixedToFloating  IRate Floater        -- ^ Paying Fixed Rate and receiving Floating rate
                  | FormulaToFloating   DealStats Floater    -- ^ Paying Formula Rate and receiving Floating rate
                  | FloatingToFormula   Floater DealStats    -- ^ Paying Floating Rate and receiving Formula rate
                  deriving(Int -> RateSwapType -> ShowS
[RateSwapType] -> ShowS
RateSwapType -> String
(Int -> RateSwapType -> ShowS)
-> (RateSwapType -> String)
-> ([RateSwapType] -> ShowS)
-> Show RateSwapType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RateSwapType -> ShowS
showsPrec :: Int -> RateSwapType -> ShowS
$cshow :: RateSwapType -> String
show :: RateSwapType -> String
$cshowList :: [RateSwapType] -> ShowS
showList :: [RateSwapType] -> ShowS
Show,(forall x. RateSwapType -> Rep RateSwapType x)
-> (forall x. Rep RateSwapType x -> RateSwapType)
-> Generic RateSwapType
forall x. Rep RateSwapType x -> RateSwapType
forall x. RateSwapType -> Rep RateSwapType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RateSwapType -> Rep RateSwapType x
from :: forall x. RateSwapType -> Rep RateSwapType x
$cto :: forall x. Rep RateSwapType x -> RateSwapType
to :: forall x. Rep RateSwapType x -> RateSwapType
Generic,RateSwapType -> RateSwapType -> Bool
(RateSwapType -> RateSwapType -> Bool)
-> (RateSwapType -> RateSwapType -> Bool) -> Eq RateSwapType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RateSwapType -> RateSwapType -> Bool
== :: RateSwapType -> RateSwapType -> Bool
$c/= :: RateSwapType -> RateSwapType -> Bool
/= :: RateSwapType -> RateSwapType -> Bool
Eq,Eq RateSwapType
Eq RateSwapType =>
(RateSwapType -> RateSwapType -> Ordering)
-> (RateSwapType -> RateSwapType -> Bool)
-> (RateSwapType -> RateSwapType -> Bool)
-> (RateSwapType -> RateSwapType -> Bool)
-> (RateSwapType -> RateSwapType -> Bool)
-> (RateSwapType -> RateSwapType -> RateSwapType)
-> (RateSwapType -> RateSwapType -> RateSwapType)
-> Ord RateSwapType
RateSwapType -> RateSwapType -> Bool
RateSwapType -> RateSwapType -> Ordering
RateSwapType -> RateSwapType -> RateSwapType
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 :: RateSwapType -> RateSwapType -> Ordering
compare :: RateSwapType -> RateSwapType -> Ordering
$c< :: RateSwapType -> RateSwapType -> Bool
< :: RateSwapType -> RateSwapType -> Bool
$c<= :: RateSwapType -> RateSwapType -> Bool
<= :: RateSwapType -> RateSwapType -> Bool
$c> :: RateSwapType -> RateSwapType -> Bool
> :: RateSwapType -> RateSwapType -> Bool
$c>= :: RateSwapType -> RateSwapType -> Bool
>= :: RateSwapType -> RateSwapType -> Bool
$cmax :: RateSwapType -> RateSwapType -> RateSwapType
max :: RateSwapType -> RateSwapType -> RateSwapType
$cmin :: RateSwapType -> RateSwapType -> RateSwapType
min :: RateSwapType -> RateSwapType -> RateSwapType
Ord)

data RateSwap = RateSwap {RateSwap -> RateSwapType
rsType :: RateSwapType         -- ^ swap type
                          ,RateSwap -> DayCount
rsDayCount :: DayCount        -- ^ day count convention
                          ,RateSwap -> Maybe (SettleDates, String)
rsSettleDates :: Maybe (SettleDates,String)         -- ^ define settle dates
                          ,RateSwap -> SettleDates
rsUpdateDates :: DatePattern   -- ^ define observe dates

                          ,RateSwap -> RateSwapBase
rsNotional :: RateSwapBase     -- ^ define notional balance
                          ,RateSwap -> Balance
rsRefBalance :: Balance        -- ^ notional balance in use
                          
                          ,RateSwap -> IRate
rsPayingRate :: IRate          -- ^ collect rate
                          ,RateSwap -> IRate
rsReceivingRate :: IRate       -- ^ paying rate
                          
                          ,RateSwap -> Balance
rsNetCash :: Balance           -- ^ amount to pay/collect
                          
                          ,RateSwap -> StartDate
rsStartDate :: StartDate       -- ^ swap start date
                          ,RateSwap -> Maybe StartDate
rsLastStlDate :: Maybe Date    -- ^ last settle date
                          ,RateSwap -> Maybe Statement
rsStmt :: Maybe Statement      -- ^ transaction history
                          }
                          deriving(Int -> RateSwap -> ShowS
[RateSwap] -> ShowS
RateSwap -> String
(Int -> RateSwap -> ShowS)
-> (RateSwap -> String) -> ([RateSwap] -> ShowS) -> Show RateSwap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RateSwap -> ShowS
showsPrec :: Int -> RateSwap -> ShowS
$cshow :: RateSwap -> String
show :: RateSwap -> String
$cshowList :: [RateSwap] -> ShowS
showList :: [RateSwap] -> ShowS
Show,(forall x. RateSwap -> Rep RateSwap x)
-> (forall x. Rep RateSwap x -> RateSwap) -> Generic RateSwap
forall x. Rep RateSwap x -> RateSwap
forall x. RateSwap -> Rep RateSwap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RateSwap -> Rep RateSwap x
from :: forall x. RateSwap -> Rep RateSwap x
$cto :: forall x. Rep RateSwap x -> RateSwap
to :: forall x. Rep RateSwap x -> RateSwap
Generic,RateSwap -> RateSwap -> Bool
(RateSwap -> RateSwap -> Bool)
-> (RateSwap -> RateSwap -> Bool) -> Eq RateSwap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RateSwap -> RateSwap -> Bool
== :: RateSwap -> RateSwap -> Bool
$c/= :: RateSwap -> RateSwap -> Bool
/= :: RateSwap -> RateSwap -> Bool
Eq,Eq RateSwap
Eq RateSwap =>
(RateSwap -> RateSwap -> Ordering)
-> (RateSwap -> RateSwap -> Bool)
-> (RateSwap -> RateSwap -> Bool)
-> (RateSwap -> RateSwap -> Bool)
-> (RateSwap -> RateSwap -> Bool)
-> (RateSwap -> RateSwap -> RateSwap)
-> (RateSwap -> RateSwap -> RateSwap)
-> Ord RateSwap
RateSwap -> RateSwap -> Bool
RateSwap -> RateSwap -> Ordering
RateSwap -> RateSwap -> RateSwap
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 :: RateSwap -> RateSwap -> Ordering
compare :: RateSwap -> RateSwap -> Ordering
$c< :: RateSwap -> RateSwap -> Bool
< :: RateSwap -> RateSwap -> Bool
$c<= :: RateSwap -> RateSwap -> Bool
<= :: RateSwap -> RateSwap -> Bool
$c> :: RateSwap -> RateSwap -> Bool
> :: RateSwap -> RateSwap -> Bool
$c>= :: RateSwap -> RateSwap -> Bool
>= :: RateSwap -> RateSwap -> Bool
$cmax :: RateSwap -> RateSwap -> RateSwap
max :: RateSwap -> RateSwap -> RateSwap
$cmin :: RateSwap -> RateSwap -> RateSwap
min :: RateSwap -> RateSwap -> RateSwap
Ord)

-- | The `accrueIRS` will calculate the `Net` amount 
-- ( payble with negative, positve with receivable) of Rate Swap      
accrueIRS :: Date -> RateSwap -> RateSwap
accrueIRS :: StartDate -> RateSwap -> RateSwap
accrueIRS StartDate
d rs :: RateSwap
rs@RateSwap{rsRefBalance :: RateSwap -> Balance
rsRefBalance = Balance
face               
                      , rsPayingRate :: RateSwap -> IRate
rsPayingRate = IRate
payRate            
                      , rsReceivingRate :: RateSwap -> IRate
rsReceivingRate = IRate
receiveRate     
                      , rsNetCash :: RateSwap -> Balance
rsNetCash = Balance
netCash     
                      , rsDayCount :: RateSwap -> DayCount
rsDayCount = DayCount
dc          
                      , rsStmt :: RateSwap -> Maybe Statement
rsStmt = Maybe Statement
stmt}                    
  = RateSwap
rs {rsNetCash = newNet , rsLastStlDate = Just d, rsStmt = appendStmt newTxn stmt}
      where 
          accureStartDate :: StartDate
accureStartDate = case RateSwap -> Maybe StartDate
rsLastStlDate RateSwap
rs of 
                              Maybe StartDate
Nothing ->  RateSwap -> StartDate
rsStartDate RateSwap
rs 
                              Just StartDate
lsd -> StartDate
lsd
          rateDiff :: IRate
rateDiff =  IRate
receiveRate IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
- IRate
payRate 
          yearFactor :: Balance
yearFactor = Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational (Rational -> Balance) -> Rational -> Balance
forall a b. (a -> b) -> a -> b
$ DayCount -> StartDate -> StartDate -> Rational
yearCountFraction DayCount
dc StartDate
accureStartDate StartDate
d
          newNetAmount :: Balance
newNetAmount = Balance -> IRate -> Balance
mulBIR (Balance
face Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
* Balance
yearFactor) IRate
rateDiff  -- `debug` ("Diff rate"++ show rateDiff)
          newNet :: Balance
newNet = Balance
netCash Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
newNetAmount
          newTxn :: Txn
newTxn = StartDate
-> Balance
-> Balance
-> IRate
-> IRate
-> Balance
-> TxnComment
-> Txn
IrsTxn StartDate
d Balance
face Balance
newNetAmount IRate
payRate IRate
receiveRate Balance
newNet TxnComment
SwapAccrue

-- | set rate swap to state of receive all cash from counterparty
receiveIRS :: Date -> RateSwap -> RateSwap 
receiveIRS :: StartDate -> RateSwap -> RateSwap
receiveIRS StartDate
d rs :: RateSwap
rs@RateSwap{rsNetCash :: RateSwap -> Balance
rsNetCash = Balance
receiveAmt, rsStmt :: RateSwap -> Maybe Statement
rsStmt = Maybe Statement
stmt} 
  | Balance
receiveAmt Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0 = RateSwap
rs { rsNetCash = 0 ,rsStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 (SwapInSettle "")) stmt}
  | Bool
otherwise = RateSwap
rs

-- | set rate swap to state of payout all possible cash to counterparty
payoutIRS :: Date -> Amount -> RateSwap -> RateSwap 
payoutIRS :: StartDate -> Balance -> RateSwap -> RateSwap
payoutIRS StartDate
d Balance
amt rs :: RateSwap
rs@RateSwap{rsNetCash :: RateSwap -> Balance
rsNetCash = Balance
payoutAmt, rsStmt :: RateSwap -> Maybe Statement
rsStmt = Maybe Statement
stmt} 
  | Balance
payoutAmt Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance
0  =  RateSwap
rs { rsNetCash = outstanding, rsStmt = newStmt }
  | Bool
otherwise = RateSwap
rs
      where 
        actualAmt :: Balance
actualAmt = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
amt (Balance -> Balance
forall a. Num a => a -> a
negate Balance
payoutAmt)  --TODO need to add a check here
        outstanding :: Balance
outstanding = Balance
payoutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
actualAmt
        newStmt :: Maybe Statement
newStmt = Txn -> Maybe Statement -> Maybe Statement
appendStmt (StartDate
-> Balance
-> Balance
-> IRate
-> IRate
-> Balance
-> TxnComment
-> Txn
IrsTxn StartDate
d Balance
0 Balance
actualAmt IRate
0 IRate
0 Balance
0 (String -> TxnComment
SwapOutSettle String
"")) Maybe Statement
stmt 

instance QueryByComment RateSwap where 
    queryStmt :: RateSwap -> TxnComment -> [Txn]
queryStmt RateSwap{rsStmt :: RateSwap -> Maybe Statement
rsStmt = Maybe Statement
Nothing} TxnComment
tc = []
    queryStmt RateSwap{rsStmt :: RateSwap -> Maybe Statement
rsStmt = Just (Statement DList Txn
txns)} TxnComment
tc
      = (Txn -> Bool) -> [Txn] -> [Txn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Txn
x -> Txn -> TxnComment
getTxnComment Txn
x TxnComment -> TxnComment -> Bool
forall a. Eq a => a -> a -> Bool
== TxnComment
tc) (DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList DList Txn
txns)

instance Liable RateSwap where 
  isPaidOff :: RateSwap -> Bool
isPaidOff rs :: RateSwap
rs@RateSwap{rsNetCash :: RateSwap -> Balance
rsNetCash=Balance
bal}
    | Balance
bal Balance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
== Balance
0 = Bool
True
    | Bool
otherwise = Bool
False

  getOutstandingAmount :: RateSwap -> Balance
getOutstandingAmount rs :: RateSwap
rs@RateSwap{rsNetCash :: RateSwap -> Balance
rsNetCash=Balance
bal} 
    | Balance
bal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance
0 = Balance -> Balance
forall a. Num a => a -> a
negate Balance
bal
    | Bool
otherwise = Balance
0

data RateCap = RateCap {
                RateCap -> Index
rcIndex :: Types.Index
                ,RateCap -> Ts
rcStrikeRate :: Ts
                ,RateCap -> RateSwapBase
rcNotional :: RateSwapBase
                ,RateCap -> StartDate
rcStartDate :: Date
                ,RateCap -> SettleDates
rcSettleDates :: DatePattern
                ,RateCap -> StartDate
rcEndDate :: Date
                ,RateCap -> IRate
rcReceivingRate :: IRate       -- ^ receiving rate
                ,RateCap -> Maybe StartDate
rcLastStlDate :: Maybe Date    -- ^ last settle date
                ,RateCap -> Balance
rcNetCash :: Balance           -- ^ amount to collect
                ,RateCap -> Maybe Statement
rcStmt :: Maybe Statement      -- ^ transaction history                
              }
              deriving(Int -> RateCap -> ShowS
[RateCap] -> ShowS
RateCap -> String
(Int -> RateCap -> ShowS)
-> (RateCap -> String) -> ([RateCap] -> ShowS) -> Show RateCap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RateCap -> ShowS
showsPrec :: Int -> RateCap -> ShowS
$cshow :: RateCap -> String
show :: RateCap -> String
$cshowList :: [RateCap] -> ShowS
showList :: [RateCap] -> ShowS
Show,(forall x. RateCap -> Rep RateCap x)
-> (forall x. Rep RateCap x -> RateCap) -> Generic RateCap
forall x. Rep RateCap x -> RateCap
forall x. RateCap -> Rep RateCap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RateCap -> Rep RateCap x
from :: forall x. RateCap -> Rep RateCap x
$cto :: forall x. Rep RateCap x -> RateCap
to :: forall x. Rep RateCap x -> RateCap
Generic,RateCap -> RateCap -> Bool
(RateCap -> RateCap -> Bool)
-> (RateCap -> RateCap -> Bool) -> Eq RateCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RateCap -> RateCap -> Bool
== :: RateCap -> RateCap -> Bool
$c/= :: RateCap -> RateCap -> Bool
/= :: RateCap -> RateCap -> Bool
Eq,Eq RateCap
Eq RateCap =>
(RateCap -> RateCap -> Ordering)
-> (RateCap -> RateCap -> Bool)
-> (RateCap -> RateCap -> Bool)
-> (RateCap -> RateCap -> Bool)
-> (RateCap -> RateCap -> Bool)
-> (RateCap -> RateCap -> RateCap)
-> (RateCap -> RateCap -> RateCap)
-> Ord RateCap
RateCap -> RateCap -> Bool
RateCap -> RateCap -> Ordering
RateCap -> RateCap -> RateCap
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 :: RateCap -> RateCap -> Ordering
compare :: RateCap -> RateCap -> Ordering
$c< :: RateCap -> RateCap -> Bool
< :: RateCap -> RateCap -> Bool
$c<= :: RateCap -> RateCap -> Bool
<= :: RateCap -> RateCap -> Bool
$c> :: RateCap -> RateCap -> Bool
> :: RateCap -> RateCap -> Bool
$c>= :: RateCap -> RateCap -> Bool
>= :: RateCap -> RateCap -> Bool
$cmax :: RateCap -> RateCap -> RateCap
max :: RateCap -> RateCap -> RateCap
$cmin :: RateCap -> RateCap -> RateCap
min :: RateCap -> RateCap -> RateCap
Ord)


receiveRC :: Date -> RateCap -> RateCap
receiveRC :: StartDate -> RateCap -> RateCap
receiveRC StartDate
d rc :: RateCap
rc@RateCap{rcNetCash :: RateCap -> Balance
rcNetCash = Balance
receiveAmt, rcStmt :: RateCap -> Maybe Statement
rcStmt = Maybe Statement
stmt} 
  | Balance
receiveAmt Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0 = RateCap
rc { rcNetCash = 0 ,rcStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 (SwapInSettle "")) stmt}
  | Bool
otherwise = RateCap
rc

instance IR.UseRate RateCap where 
  getIndexes :: RateCap -> Maybe [Index]
getIndexes rc :: RateCap
rc@RateCap{rcIndex :: RateCap -> Index
rcIndex = Index
idx} = [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx]

instance QueryByComment RateCap where 
    queryStmt :: RateCap -> TxnComment -> [Txn]
queryStmt RateCap{rcStmt :: RateCap -> Maybe Statement
rcStmt = Maybe Statement
Nothing} TxnComment
tc = []
    queryStmt RateCap{rcStmt :: RateCap -> Maybe Statement
rcStmt = Just (Statement DList Txn
txns)} TxnComment
tc
      = (Txn -> Bool) -> [Txn] -> [Txn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Txn
x -> Txn -> TxnComment
getTxnComment Txn
x TxnComment -> TxnComment -> Bool
forall a. Eq a => a -> a -> Bool
== TxnComment
tc) (DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList DList Txn
txns)


data CurrencySwap = CurrencySwap {
                    CurrencySwap -> Balance
csBalance :: Balance
                    } deriving (Int -> CurrencySwap -> ShowS
[CurrencySwap] -> ShowS
CurrencySwap -> String
(Int -> CurrencySwap -> ShowS)
-> (CurrencySwap -> String)
-> ([CurrencySwap] -> ShowS)
-> Show CurrencySwap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CurrencySwap -> ShowS
showsPrec :: Int -> CurrencySwap -> ShowS
$cshow :: CurrencySwap -> String
show :: CurrencySwap -> String
$cshowList :: [CurrencySwap] -> ShowS
showList :: [CurrencySwap] -> ShowS
Show,(forall x. CurrencySwap -> Rep CurrencySwap x)
-> (forall x. Rep CurrencySwap x -> CurrencySwap)
-> Generic CurrencySwap
forall x. Rep CurrencySwap x -> CurrencySwap
forall x. CurrencySwap -> Rep CurrencySwap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CurrencySwap -> Rep CurrencySwap x
from :: forall x. CurrencySwap -> Rep CurrencySwap x
$cto :: forall x. Rep CurrencySwap x -> CurrencySwap
to :: forall x. Rep CurrencySwap x -> CurrencySwap
Generic,Eq CurrencySwap
Eq CurrencySwap =>
(CurrencySwap -> CurrencySwap -> Ordering)
-> (CurrencySwap -> CurrencySwap -> Bool)
-> (CurrencySwap -> CurrencySwap -> Bool)
-> (CurrencySwap -> CurrencySwap -> Bool)
-> (CurrencySwap -> CurrencySwap -> Bool)
-> (CurrencySwap -> CurrencySwap -> CurrencySwap)
-> (CurrencySwap -> CurrencySwap -> CurrencySwap)
-> Ord CurrencySwap
CurrencySwap -> CurrencySwap -> Bool
CurrencySwap -> CurrencySwap -> Ordering
CurrencySwap -> CurrencySwap -> CurrencySwap
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 :: CurrencySwap -> CurrencySwap -> Ordering
compare :: CurrencySwap -> CurrencySwap -> Ordering
$c< :: CurrencySwap -> CurrencySwap -> Bool
< :: CurrencySwap -> CurrencySwap -> Bool
$c<= :: CurrencySwap -> CurrencySwap -> Bool
<= :: CurrencySwap -> CurrencySwap -> Bool
$c> :: CurrencySwap -> CurrencySwap -> Bool
> :: CurrencySwap -> CurrencySwap -> Bool
$c>= :: CurrencySwap -> CurrencySwap -> Bool
>= :: CurrencySwap -> CurrencySwap -> Bool
$cmax :: CurrencySwap -> CurrencySwap -> CurrencySwap
max :: CurrencySwap -> CurrencySwap -> CurrencySwap
$cmin :: CurrencySwap -> CurrencySwap -> CurrencySwap
min :: CurrencySwap -> CurrencySwap -> CurrencySwap
Ord,CurrencySwap -> CurrencySwap -> Bool
(CurrencySwap -> CurrencySwap -> Bool)
-> (CurrencySwap -> CurrencySwap -> Bool) -> Eq CurrencySwap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CurrencySwap -> CurrencySwap -> Bool
== :: CurrencySwap -> CurrencySwap -> Bool
$c/= :: CurrencySwap -> CurrencySwap -> Bool
/= :: CurrencySwap -> CurrencySwap -> Bool
Eq)

instance IR.UseRate RateSwap where 
  getIndexes :: RateSwap -> Maybe [Index]
getIndexes rs :: RateSwap
rs@RateSwap{rsType :: RateSwap -> RateSwapType
rsType = RateSwapType
rstype}
    = case RateSwapType
rstype of
        FloatingToFloating (Index
idx1,IRate
_) (Index
idx2,IRate
_) -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx1,Index
idx2]
        FloatingToFixed (Index
idx1,IRate
_) IRate
_ -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx1]
        FixedToFloating IRate
_ (Index
idx1,IRate
_) -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx1]
        RateSwapType
_ -> Maybe [Index]
forall a. Maybe a
Nothing

makeLensesFor [("rsType","rsTypeLens"),("rsRefBalance","rsRefBalLens")] ''RateSwap

data SrtType = SrtByEndDay DealStats DatePattern  -- ^ autu accrue by end of day
              deriving(Int -> SrtType -> ShowS
[SrtType] -> ShowS
SrtType -> String
(Int -> SrtType -> ShowS)
-> (SrtType -> String) -> ([SrtType] -> ShowS) -> Show SrtType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrtType -> ShowS
showsPrec :: Int -> SrtType -> ShowS
$cshow :: SrtType -> String
show :: SrtType -> String
$cshowList :: [SrtType] -> ShowS
showList :: [SrtType] -> ShowS
Show,(forall x. SrtType -> Rep SrtType x)
-> (forall x. Rep SrtType x -> SrtType) -> Generic SrtType
forall x. Rep SrtType x -> SrtType
forall x. SrtType -> Rep SrtType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SrtType -> Rep SrtType x
from :: forall x. SrtType -> Rep SrtType x
$cto :: forall x. Rep SrtType x -> SrtType
to :: forall x. Rep SrtType x -> SrtType
Generic,SrtType -> SrtType -> Bool
(SrtType -> SrtType -> Bool)
-> (SrtType -> SrtType -> Bool) -> Eq SrtType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrtType -> SrtType -> Bool
== :: SrtType -> SrtType -> Bool
$c/= :: SrtType -> SrtType -> Bool
/= :: SrtType -> SrtType -> Bool
Eq,Eq SrtType
Eq SrtType =>
(SrtType -> SrtType -> Ordering)
-> (SrtType -> SrtType -> Bool)
-> (SrtType -> SrtType -> Bool)
-> (SrtType -> SrtType -> Bool)
-> (SrtType -> SrtType -> Bool)
-> (SrtType -> SrtType -> SrtType)
-> (SrtType -> SrtType -> SrtType)
-> Ord SrtType
SrtType -> SrtType -> Bool
SrtType -> SrtType -> Ordering
SrtType -> SrtType -> SrtType
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 :: SrtType -> SrtType -> Ordering
compare :: SrtType -> SrtType -> Ordering
$c< :: SrtType -> SrtType -> Bool
< :: SrtType -> SrtType -> Bool
$c<= :: SrtType -> SrtType -> Bool
<= :: SrtType -> SrtType -> Bool
$c> :: SrtType -> SrtType -> Bool
> :: SrtType -> SrtType -> Bool
$c>= :: SrtType -> SrtType -> Bool
>= :: SrtType -> SrtType -> Bool
$cmax :: SrtType -> SrtType -> SrtType
max :: SrtType -> SrtType -> SrtType
$cmin :: SrtType -> SrtType -> SrtType
min :: SrtType -> SrtType -> SrtType
Ord)


data SRT = SRT {
    SRT -> String
srtName :: String 
    ,SRT -> SrtType
srtType :: SrtType 
    ,SRT -> RateType
srtPremiumType :: IR.RateType              -- ^ define how/when to update the balance
    
    ,SRT -> Balance
srtRefBalance :: Balance                   -- ^ balance to calc premium
    ,SRT -> IRate
srtPremiumRate :: IRate                    -- ^ current interest rated on oustanding balance

    ,SRT -> Balance
srtOpenBalance :: Balance                  -- ^ total open balance
    
    ,SRT -> Maybe StartDate
srtDuePremiumDate :: Maybe Date            -- ^ last day of interest/premium calculated
    ,SRT -> Balance
srtDuePremium :: Balance                   -- ^ oustanding due on premium
    
    ,SRT -> StartDate
srtStart :: Date                           -- ^ when liquidiy provider came into effective
    ,SRT -> Maybe StartDate
srtEnds :: Maybe Date                      -- ^ when liquidiy provider came into expired
    ,SRT -> Maybe Statement
srtStmt :: Maybe Statement                 -- ^ transaction history
} deriving (Int -> SRT -> ShowS
[SRT] -> ShowS
SRT -> String
(Int -> SRT -> ShowS)
-> (SRT -> String) -> ([SRT] -> ShowS) -> Show SRT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SRT -> ShowS
showsPrec :: Int -> SRT -> ShowS
$cshow :: SRT -> String
show :: SRT -> String
$cshowList :: [SRT] -> ShowS
showList :: [SRT] -> ShowS
Show,(forall x. SRT -> Rep SRT x)
-> (forall x. Rep SRT x -> SRT) -> Generic SRT
forall x. Rep SRT x -> SRT
forall x. SRT -> Rep SRT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SRT -> Rep SRT x
from :: forall x. SRT -> Rep SRT x
$cto :: forall x. Rep SRT x -> SRT
to :: forall x. Rep SRT x -> SRT
Generic,SRT -> SRT -> Bool
(SRT -> SRT -> Bool) -> (SRT -> SRT -> Bool) -> Eq SRT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SRT -> SRT -> Bool
== :: SRT -> SRT -> Bool
$c/= :: SRT -> SRT -> Bool
/= :: SRT -> SRT -> Bool
Eq,Eq SRT
Eq SRT =>
(SRT -> SRT -> Ordering)
-> (SRT -> SRT -> Bool)
-> (SRT -> SRT -> Bool)
-> (SRT -> SRT -> Bool)
-> (SRT -> SRT -> Bool)
-> (SRT -> SRT -> SRT)
-> (SRT -> SRT -> SRT)
-> Ord SRT
SRT -> SRT -> Bool
SRT -> SRT -> Ordering
SRT -> SRT -> SRT
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 :: SRT -> SRT -> Ordering
compare :: SRT -> SRT -> Ordering
$c< :: SRT -> SRT -> Bool
< :: SRT -> SRT -> Bool
$c<= :: SRT -> SRT -> Bool
<= :: SRT -> SRT -> Bool
$c> :: SRT -> SRT -> Bool
> :: SRT -> SRT -> Bool
$c>= :: SRT -> SRT -> Bool
>= :: SRT -> SRT -> Bool
$cmax :: SRT -> SRT -> SRT
max :: SRT -> SRT -> SRT
$cmin :: SRT -> SRT -> SRT
min :: SRT -> SRT -> SRT
Ord)

instance Liable SRT where 
  isPaidOff :: SRT -> Bool
isPaidOff srt :: SRT
srt@SRT{srtOpenBalance :: SRT -> Balance
srtOpenBalance=Balance
bal,srtDuePremium :: SRT -> Balance
srtDuePremium=Balance
duePremium}
    | Balance
balBalance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
==Balance
0 Bool -> Bool -> Bool
&& Balance
duePremiumBalance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
==Balance
0 = Bool
True
    | Bool
otherwise = Bool
False

instance IR.UseRate SRT where 
  getIndexes :: SRT -> Maybe [Index]
getIndexes srt :: SRT
srt@SRT{srtPremiumType :: SRT -> RateType
srtPremiumType = RateType
rt} 
    = case RateType
rt of 
        (IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ SettleDates
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_ ) -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx]
        RateType
_ -> Maybe [Index]
forall a. Maybe a
Nothing
  
  getResetDates :: SRT -> Dates
getResetDates srt :: SRT
srt@SRT{srtPremiumType :: SRT -> RateType
srtPremiumType = RateType
rt , srtStart :: SRT -> StartDate
srtStart = StartDate
sd, srtEnds :: SRT -> Maybe StartDate
srtEnds = Just StartDate
ed} 
    = case RateType
rt of 
        (IR.Floater DayCount
_ Index
_ IRate
_ IRate
_ SettleDates
dp Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_ ) -> RangeType -> StartDate -> SettleDates -> StartDate -> Dates
genSerialDatesTill2 RangeType
EI StartDate
sd SettleDates
dp StartDate
ed
        RateType
_ -> []

-- | update the reset events of liquidity provider
buildSrtAccrueAction :: [SRT] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildSrtAccrueAction :: [SRT] -> StartDate -> [(String, Dates)] -> [(String, Dates)]
buildSrtAccrueAction [] StartDate
ed [(String, Dates)]
r = [(String, Dates)]
r
buildSrtAccrueAction (SRT
srt:[SRT]
srts) StartDate
ed [(String, Dates)]
r = 
  case SRT
srt of 
    (SRT String
srtName (SrtByEndDay DealStats
_ SettleDates
dp ) RateType
_ Balance
_ IRate
_ Balance
_ Maybe StartDate
_ Balance
_ StartDate
ss Maybe StartDate
_ Maybe Statement
_ )
      -> [SRT] -> StartDate -> [(String, Dates)] -> [(String, Dates)]
buildSrtAccrueAction
           [SRT]
srts
           StartDate
ed
           [(String
srtName, SettleDates -> StartDate -> StartDate -> Dates
projDatesByPattern SettleDates
dp StartDate
ss StartDate
ed)][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r
    SRT
_ -> [SRT] -> StartDate -> [(String, Dates)] -> [(String, Dates)]
buildSrtAccrueAction [SRT]
srts StartDate
ed [(String, Dates)]
r

buildSrtResetAction :: [SRT] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildSrtResetAction :: [SRT] -> StartDate -> [(String, Dates)] -> [(String, Dates)]
buildSrtResetAction [] StartDate
ed [(String, Dates)]
r = [(String, Dates)]
r
buildSrtResetAction (SRT
srt:[SRT]
srts) StartDate
ed [(String, Dates)]
r = 
  case SRT
srt of 
    srt :: SRT
srt@SRT{srtPremiumType :: SRT -> RateType
srtPremiumType = RateType
rt, srtName :: SRT -> String
srtName = String
ln , srtStart :: SRT -> StartDate
srtStart = StartDate
sd} -> 
       [SRT] -> StartDate -> [(String, Dates)] -> [(String, Dates)]
buildSrtResetAction 
        [SRT]
srts 
        StartDate
ed 
        [(String
ln,StartDate -> StartDate -> Maybe RateType -> Dates
IR.getRateResetDates StartDate
sd StartDate
ed (RateType -> Maybe RateType
forall a. a -> Maybe a
Just RateType
rt))][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r
    SRT
_ -> [SRT] -> StartDate -> [(String, Dates)] -> [(String, Dates)]
buildSrtResetAction [SRT]
srts StartDate
ed [(String, Dates)]
r




$(concat <$> traverse (deriveJSON defaultOptions) [''RateSwap, ''RateCap, ''RateSwapType, ''RateSwapBase, ''CurrencySwap])