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

module CreditEnhancement
  (LiqFacility(..),LiqSupportType(..),buildLiqResetAction,buildLiqRateResetAction
  ,LiquidityProviderName,draw,repay,accrueLiqProvider
  ,LiqDrawType(..),LiqRepayType(..),LiqCreditCalc(..)
  ,consolStmt,CreditDefaultSwap(..),
  )
  where

import qualified Data.Text as T
import qualified Data.Time as Time
import qualified Data.Map as Map
import qualified Data.DList as DL
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 Types
import Util
import DateUtil
import Stmt
import qualified InterestRate as IR

import qualified Stmt as S

import Debug.Trace
import Lib (paySeqLiabilities)
import Data.Decimal
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 LiquidityProviderName = String

-- ^ describle credit support 
data LiqSupportType = ReplenishSupport DatePattern Balance    -- ^ Credit will be refresh by an interval
                    | FixSupport Balance                      -- ^ Fixed credit amount
                    | ByPct DealStats Rate                    -- ^ By a pct of formula
                    | UnLimit                                 -- ^ Unlimit credit support, like insurance company
                    deriving(Int -> LiqSupportType -> ShowS
[LiqSupportType] -> ShowS
LiqSupportType -> String
(Int -> LiqSupportType -> ShowS)
-> (LiqSupportType -> String)
-> ([LiqSupportType] -> ShowS)
-> Show LiqSupportType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiqSupportType -> ShowS
showsPrec :: Int -> LiqSupportType -> ShowS
$cshow :: LiqSupportType -> String
show :: LiqSupportType -> String
$cshowList :: [LiqSupportType] -> ShowS
showList :: [LiqSupportType] -> ShowS
Show,(forall x. LiqSupportType -> Rep LiqSupportType x)
-> (forall x. Rep LiqSupportType x -> LiqSupportType)
-> Generic LiqSupportType
forall x. Rep LiqSupportType x -> LiqSupportType
forall x. LiqSupportType -> Rep LiqSupportType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LiqSupportType -> Rep LiqSupportType x
from :: forall x. LiqSupportType -> Rep LiqSupportType x
$cto :: forall x. Rep LiqSupportType x -> LiqSupportType
to :: forall x. Rep LiqSupportType x -> LiqSupportType
Generic,LiqSupportType -> LiqSupportType -> Bool
(LiqSupportType -> LiqSupportType -> Bool)
-> (LiqSupportType -> LiqSupportType -> Bool) -> Eq LiqSupportType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LiqSupportType -> LiqSupportType -> Bool
== :: LiqSupportType -> LiqSupportType -> Bool
$c/= :: LiqSupportType -> LiqSupportType -> Bool
/= :: LiqSupportType -> LiqSupportType -> Bool
Eq,Eq LiqSupportType
Eq LiqSupportType =>
(LiqSupportType -> LiqSupportType -> Ordering)
-> (LiqSupportType -> LiqSupportType -> Bool)
-> (LiqSupportType -> LiqSupportType -> Bool)
-> (LiqSupportType -> LiqSupportType -> Bool)
-> (LiqSupportType -> LiqSupportType -> Bool)
-> (LiqSupportType -> LiqSupportType -> LiqSupportType)
-> (LiqSupportType -> LiqSupportType -> LiqSupportType)
-> Ord LiqSupportType
LiqSupportType -> LiqSupportType -> Bool
LiqSupportType -> LiqSupportType -> Ordering
LiqSupportType -> LiqSupportType -> LiqSupportType
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 :: LiqSupportType -> LiqSupportType -> Ordering
compare :: LiqSupportType -> LiqSupportType -> Ordering
$c< :: LiqSupportType -> LiqSupportType -> Bool
< :: LiqSupportType -> LiqSupportType -> Bool
$c<= :: LiqSupportType -> LiqSupportType -> Bool
<= :: LiqSupportType -> LiqSupportType -> Bool
$c> :: LiqSupportType -> LiqSupportType -> Bool
> :: LiqSupportType -> LiqSupportType -> Bool
$c>= :: LiqSupportType -> LiqSupportType -> Bool
>= :: LiqSupportType -> LiqSupportType -> Bool
$cmax :: LiqSupportType -> LiqSupportType -> LiqSupportType
max :: LiqSupportType -> LiqSupportType -> LiqSupportType
$cmin :: LiqSupportType -> LiqSupportType -> LiqSupportType
min :: LiqSupportType -> LiqSupportType -> LiqSupportType
Ord)


data LiqDrawType = LiqToAcc        -- ^ draw credit and deposit cash to account
                 | LiqToBondInt    -- ^ draw credit and pay to bond interest if any shortfall
                 | LiqToBondPrin   -- ^ draw credit and pay to bond principal if any shortfall
                 | LiqToFee        -- ^ draw credit and pay to a fee if there is a shortfall
                 deriving (Int -> LiqDrawType -> ShowS
[LiqDrawType] -> ShowS
LiqDrawType -> String
(Int -> LiqDrawType -> ShowS)
-> (LiqDrawType -> String)
-> ([LiqDrawType] -> ShowS)
-> Show LiqDrawType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiqDrawType -> ShowS
showsPrec :: Int -> LiqDrawType -> ShowS
$cshow :: LiqDrawType -> String
show :: LiqDrawType -> String
$cshowList :: [LiqDrawType] -> ShowS
showList :: [LiqDrawType] -> ShowS
Show,(forall x. LiqDrawType -> Rep LiqDrawType x)
-> (forall x. Rep LiqDrawType x -> LiqDrawType)
-> Generic LiqDrawType
forall x. Rep LiqDrawType x -> LiqDrawType
forall x. LiqDrawType -> Rep LiqDrawType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LiqDrawType -> Rep LiqDrawType x
from :: forall x. LiqDrawType -> Rep LiqDrawType x
$cto :: forall x. Rep LiqDrawType x -> LiqDrawType
to :: forall x. Rep LiqDrawType x -> LiqDrawType
Generic,Eq LiqDrawType
Eq LiqDrawType =>
(LiqDrawType -> LiqDrawType -> Ordering)
-> (LiqDrawType -> LiqDrawType -> Bool)
-> (LiqDrawType -> LiqDrawType -> Bool)
-> (LiqDrawType -> LiqDrawType -> Bool)
-> (LiqDrawType -> LiqDrawType -> Bool)
-> (LiqDrawType -> LiqDrawType -> LiqDrawType)
-> (LiqDrawType -> LiqDrawType -> LiqDrawType)
-> Ord LiqDrawType
LiqDrawType -> LiqDrawType -> Bool
LiqDrawType -> LiqDrawType -> Ordering
LiqDrawType -> LiqDrawType -> LiqDrawType
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 :: LiqDrawType -> LiqDrawType -> Ordering
compare :: LiqDrawType -> LiqDrawType -> Ordering
$c< :: LiqDrawType -> LiqDrawType -> Bool
< :: LiqDrawType -> LiqDrawType -> Bool
$c<= :: LiqDrawType -> LiqDrawType -> Bool
<= :: LiqDrawType -> LiqDrawType -> Bool
$c> :: LiqDrawType -> LiqDrawType -> Bool
> :: LiqDrawType -> LiqDrawType -> Bool
$c>= :: LiqDrawType -> LiqDrawType -> Bool
>= :: LiqDrawType -> LiqDrawType -> Bool
$cmax :: LiqDrawType -> LiqDrawType -> LiqDrawType
max :: LiqDrawType -> LiqDrawType -> LiqDrawType
$cmin :: LiqDrawType -> LiqDrawType -> LiqDrawType
min :: LiqDrawType -> LiqDrawType -> LiqDrawType
Ord,LiqDrawType -> LiqDrawType -> Bool
(LiqDrawType -> LiqDrawType -> Bool)
-> (LiqDrawType -> LiqDrawType -> Bool) -> Eq LiqDrawType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LiqDrawType -> LiqDrawType -> Bool
== :: LiqDrawType -> LiqDrawType -> Bool
$c/= :: LiqDrawType -> LiqDrawType -> Bool
/= :: LiqDrawType -> LiqDrawType -> Bool
Eq)


data LiqRepayType = LiqBal         -- ^ repay oustanding balance of liquidation provider
                  | LiqPremium     -- ^ repay oustanding premium fee of lp
                  | LiqInt         -- ^ repay oustanding interest of lp
                  | LiqRepayTypes [LiqRepayType]  -- ^ repay by sequence
                  | LiqResidual    
                  | LiqOD
                  deriving (Int -> LiqRepayType -> ShowS
[LiqRepayType] -> ShowS
LiqRepayType -> String
(Int -> LiqRepayType -> ShowS)
-> (LiqRepayType -> String)
-> ([LiqRepayType] -> ShowS)
-> Show LiqRepayType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiqRepayType -> ShowS
showsPrec :: Int -> LiqRepayType -> ShowS
$cshow :: LiqRepayType -> String
show :: LiqRepayType -> String
$cshowList :: [LiqRepayType] -> ShowS
showList :: [LiqRepayType] -> ShowS
Show,(forall x. LiqRepayType -> Rep LiqRepayType x)
-> (forall x. Rep LiqRepayType x -> LiqRepayType)
-> Generic LiqRepayType
forall x. Rep LiqRepayType x -> LiqRepayType
forall x. LiqRepayType -> Rep LiqRepayType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LiqRepayType -> Rep LiqRepayType x
from :: forall x. LiqRepayType -> Rep LiqRepayType x
$cto :: forall x. Rep LiqRepayType x -> LiqRepayType
to :: forall x. Rep LiqRepayType x -> LiqRepayType
Generic,Eq LiqRepayType
Eq LiqRepayType =>
(LiqRepayType -> LiqRepayType -> Ordering)
-> (LiqRepayType -> LiqRepayType -> Bool)
-> (LiqRepayType -> LiqRepayType -> Bool)
-> (LiqRepayType -> LiqRepayType -> Bool)
-> (LiqRepayType -> LiqRepayType -> Bool)
-> (LiqRepayType -> LiqRepayType -> LiqRepayType)
-> (LiqRepayType -> LiqRepayType -> LiqRepayType)
-> Ord LiqRepayType
LiqRepayType -> LiqRepayType -> Bool
LiqRepayType -> LiqRepayType -> Ordering
LiqRepayType -> LiqRepayType -> LiqRepayType
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 :: LiqRepayType -> LiqRepayType -> Ordering
compare :: LiqRepayType -> LiqRepayType -> Ordering
$c< :: LiqRepayType -> LiqRepayType -> Bool
< :: LiqRepayType -> LiqRepayType -> Bool
$c<= :: LiqRepayType -> LiqRepayType -> Bool
<= :: LiqRepayType -> LiqRepayType -> Bool
$c> :: LiqRepayType -> LiqRepayType -> Bool
> :: LiqRepayType -> LiqRepayType -> Bool
$c>= :: LiqRepayType -> LiqRepayType -> Bool
>= :: LiqRepayType -> LiqRepayType -> Bool
$cmax :: LiqRepayType -> LiqRepayType -> LiqRepayType
max :: LiqRepayType -> LiqRepayType -> LiqRepayType
$cmin :: LiqRepayType -> LiqRepayType -> LiqRepayType
min :: LiqRepayType -> LiqRepayType -> LiqRepayType
Ord,LiqRepayType -> LiqRepayType -> Bool
(LiqRepayType -> LiqRepayType -> Bool)
-> (LiqRepayType -> LiqRepayType -> Bool) -> Eq LiqRepayType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LiqRepayType -> LiqRepayType -> Bool
== :: LiqRepayType -> LiqRepayType -> Bool
$c/= :: LiqRepayType -> LiqRepayType -> Bool
/= :: LiqRepayType -> LiqRepayType -> Bool
Eq)

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


data LiqFacility = LiqFacility {
    LiqFacility -> String
liqName :: String 
    ,LiqFacility -> LiqSupportType
liqType :: LiqSupportType 
    ,LiqFacility -> Balance
liqBalance :: Balance                   -- ^ total balance supported/drawed
    ,LiqFacility -> Maybe Balance
liqCredit :: Maybe Balance              -- ^ available balance to support. Nothing -> unlimit 
    ,LiqFacility -> Maybe LiqCreditCalc
liqCreditCalc :: Maybe LiqCreditCalc    -- ^ how to calculate credit
    
    ,LiqFacility -> Maybe RateType
liqRateType :: Maybe IR.RateType        -- ^ interest rate type 
    ,LiqFacility -> Maybe RateType
liqPremiumRateType :: Maybe IR.RateType -- ^ premium rate type
    
    ,LiqFacility -> Maybe IRate
liqRate :: Maybe IRate                  -- ^ current interest rated on oustanding balance
    ,LiqFacility -> Maybe IRate
liqPremiumRate :: Maybe IRate           -- ^ current premium rate used on unused credit, a.k. commitment fee
    
    ,LiqFacility -> Maybe Date
liqDueIntDate :: Maybe Date             -- ^ last day of interest/premium calculated
    
    ,LiqFacility -> Balance
liqDueInt :: Balance                    -- ^ oustanding due on interest
    ,LiqFacility -> Balance
liqDuePremium :: Balance                -- ^ oustanding due on premium
    
    ,LiqFacility -> Date
liqStart :: Date                        -- ^ when liquidiy provider came into effective
    ,LiqFacility -> Maybe Date
liqEnds :: Maybe Date                   -- ^ when liquidiy provider came into expired
    ,LiqFacility -> Maybe Statement
liqStmt :: Maybe Statement              -- ^ transaction history
} deriving (Int -> LiqFacility -> ShowS
[LiqFacility] -> ShowS
LiqFacility -> String
(Int -> LiqFacility -> ShowS)
-> (LiqFacility -> String)
-> ([LiqFacility] -> ShowS)
-> Show LiqFacility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiqFacility -> ShowS
showsPrec :: Int -> LiqFacility -> ShowS
$cshow :: LiqFacility -> String
show :: LiqFacility -> String
$cshowList :: [LiqFacility] -> ShowS
showList :: [LiqFacility] -> ShowS
Show,(forall x. LiqFacility -> Rep LiqFacility x)
-> (forall x. Rep LiqFacility x -> LiqFacility)
-> Generic LiqFacility
forall x. Rep LiqFacility x -> LiqFacility
forall x. LiqFacility -> Rep LiqFacility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LiqFacility -> Rep LiqFacility x
from :: forall x. LiqFacility -> Rep LiqFacility x
$cto :: forall x. Rep LiqFacility x -> LiqFacility
to :: forall x. Rep LiqFacility x -> LiqFacility
Generic,LiqFacility -> LiqFacility -> Bool
(LiqFacility -> LiqFacility -> Bool)
-> (LiqFacility -> LiqFacility -> Bool) -> Eq LiqFacility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LiqFacility -> LiqFacility -> Bool
== :: LiqFacility -> LiqFacility -> Bool
$c/= :: LiqFacility -> LiqFacility -> Bool
/= :: LiqFacility -> LiqFacility -> Bool
Eq,Eq LiqFacility
Eq LiqFacility =>
(LiqFacility -> LiqFacility -> Ordering)
-> (LiqFacility -> LiqFacility -> Bool)
-> (LiqFacility -> LiqFacility -> Bool)
-> (LiqFacility -> LiqFacility -> Bool)
-> (LiqFacility -> LiqFacility -> Bool)
-> (LiqFacility -> LiqFacility -> LiqFacility)
-> (LiqFacility -> LiqFacility -> LiqFacility)
-> Ord LiqFacility
LiqFacility -> LiqFacility -> Bool
LiqFacility -> LiqFacility -> Ordering
LiqFacility -> LiqFacility -> LiqFacility
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 :: LiqFacility -> LiqFacility -> Ordering
compare :: LiqFacility -> LiqFacility -> Ordering
$c< :: LiqFacility -> LiqFacility -> Bool
< :: LiqFacility -> LiqFacility -> Bool
$c<= :: LiqFacility -> LiqFacility -> Bool
<= :: LiqFacility -> LiqFacility -> Bool
$c> :: LiqFacility -> LiqFacility -> Bool
> :: LiqFacility -> LiqFacility -> Bool
$c>= :: LiqFacility -> LiqFacility -> Bool
>= :: LiqFacility -> LiqFacility -> Bool
$cmax :: LiqFacility -> LiqFacility -> LiqFacility
max :: LiqFacility -> LiqFacility -> LiqFacility
$cmin :: LiqFacility -> LiqFacility -> LiqFacility
min :: LiqFacility -> LiqFacility -> LiqFacility
Ord)

consolStmt :: LiqFacility -> LiqFacility
consolStmt :: LiqFacility -> LiqFacility
consolStmt liq :: LiqFacility
liq@LiqFacility{liqStmt :: LiqFacility -> Maybe Statement
liqStmt = Maybe Statement
Nothing} = LiqFacility
liq
consolStmt liq :: LiqFacility
liq@LiqFacility{liqStmt :: LiqFacility -> Maybe Statement
liqStmt = Just (S.Statement DList Txn
txn')} 
  | DList Txn
forall a. DList a
DL.empty DList Txn -> DList Txn -> Bool
forall a. Eq a => a -> a -> Bool
== DList Txn
txn' = LiqFacility
liq
  | Bool
otherwise = let 
                  (Txn
txn:[Txn]
txns) = DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList DList Txn
txn'
                  combinedBondTxns :: [Txn]
combinedBondTxns = ([Txn] -> Txn -> [Txn]) -> [Txn] -> [Txn] -> [Txn]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Txn] -> Txn -> [Txn]
S.consolTxn [Txn
txn] [Txn]
txns    
                  droppedTxns :: [Txn]
droppedTxns = (Txn -> Bool) -> [Txn] -> [Txn]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Txn -> Bool
S.isEmptyTxn [Txn]
combinedBondTxns 
                in 
                  LiqFacility
liq {liqStmt = Just (S.Statement (DL.fromList (reverse droppedTxns)))}


-- | update the reset events of liquidity provider
buildLiqResetAction :: [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqResetAction :: [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqResetAction [] Date
ed [(String, Dates)]
r = [(String, Dates)]
r
buildLiqResetAction (LiqFacility
liqProvider:[LiqFacility]
liqProviders) Date
ed [(String, Dates)]
r = 
  case LiqFacility
liqProvider of 
    (LiqFacility String
lqName (ReplenishSupport DatePattern
dp Balance
bal) Balance
_ Maybe Balance
_ Maybe LiqCreditCalc
_ Maybe RateType
_ Maybe RateType
_ Maybe IRate
_ Maybe IRate
_ Maybe Date
_ Balance
_ Balance
_ Date
ss Maybe Date
_ Maybe Statement
_) -- update the support credit of liquidity provider
      -> [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqResetAction
           [LiqFacility]
liqProviders
           Date
ed
           [(String
lqName, DatePattern -> Date -> Date -> Dates
projDatesByPattern DatePattern
dp Date
ss Date
ed)][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r
    LiqFacility
_ -> [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqResetAction [LiqFacility]
liqProviders Date
ed [(String, Dates)]
r


-- | update the rate reset events of liquidity provider
buildLiqRateResetAction  :: [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqRateResetAction :: [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqRateResetAction [] Date
ed [(String, Dates)]
r = [(String, Dates)]
r
buildLiqRateResetAction (LiqFacility
liq:[LiqFacility]
liqProviders) Date
ed [(String, Dates)]
r = 
  case LiqFacility
liq of 
    liq :: LiqFacility
liq@LiqFacility{liqRateType :: LiqFacility -> Maybe RateType
liqRateType = Maybe RateType
rt, liqPremiumRateType :: LiqFacility -> Maybe RateType
liqPremiumRateType = Maybe RateType
prt, liqName :: LiqFacility -> String
liqName = String
ln , liqStart :: LiqFacility -> Date
liqStart = Date
sd} -> 
       [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqRateResetAction 
        [LiqFacility]
liqProviders 
        Date
ed 
        [(String
ln,Date -> Date -> Maybe RateType -> Dates
IR.getRateResetDates Date
sd Date
ed Maybe RateType
rt Dates -> Dates -> Dates
forall a. [a] -> [a] -> [a]
++ Date -> Date -> Maybe RateType -> Dates
IR.getRateResetDates Date
sd Date
ed Maybe RateType
prt)][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r
    LiqFacility
_ -> [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildLiqRateResetAction [LiqFacility]
liqProviders Date
ed [(String, Dates)]
r


-- | draw cash from liquidity provider
draw :: Amount -> Date -> LiqFacility -> LiqFacility
draw :: Balance -> Date -> LiqFacility -> LiqFacility
draw  Balance
amt Date
d liq :: LiqFacility
liq@LiqFacility{ liqBalance :: LiqFacility -> Balance
liqBalance = Balance
liqBal
                            ,liqStmt :: LiqFacility -> Maybe Statement
liqStmt = Maybe Statement
mStmt
                            ,liqCredit :: LiqFacility -> Maybe Balance
liqCredit = Maybe Balance
mCredit
                            ,liqDueInt :: LiqFacility -> Balance
liqDueInt = Balance
dueInt 
                            ,liqDuePremium :: LiqFacility -> Balance
liqDuePremium = Balance
duePremium} 
  | Maybe Balance -> Bool
forall a. Maybe a -> Bool
isJust Maybe Balance
mCredit Bool -> Bool -> Bool
&& (Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe Balance
0 Maybe Balance
mCredit) Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
<= Balance
0 = 
    LiqFacility
liq { liqStmt = appendStmt (SupportTxn d mCredit liqBal dueInt duePremium 0 LiquidationDraw) mStmt }
  | Bool
otherwise = LiqFacility
liq { liqBalance = newBal,liqCredit = newCredit,liqStmt = newStmt}
    where 
        newCredit :: Maybe Balance
newCredit = (\Balance
x -> Balance
x Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
amt) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit 
        newBal :: Balance
newBal = Balance
liqBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
amt 
        newStmt :: Maybe Statement
newStmt = Txn -> Maybe Statement -> Maybe Statement
appendStmt (Date
-> Maybe Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> TxnComment
-> Txn
SupportTxn Date
d Maybe Balance
newCredit  Balance
newBal Balance
dueInt Balance
duePremium (Balance -> Balance
forall a. Num a => a -> a
negate Balance
amt) TxnComment
LiquidationDraw) Maybe Statement
mStmt


repay :: Amount -> Date -> LiqRepayType -> LiqFacility -> LiqFacility
repay :: Balance -> Date -> LiqRepayType -> LiqFacility -> LiqFacility
repay Balance
amt Date
d LiqRepayType
pt liq :: LiqFacility
liq@LiqFacility{liqBalance :: LiqFacility -> Balance
liqBalance = Balance
liqBal
                              ,liqStmt :: LiqFacility -> Maybe Statement
liqStmt = Maybe Statement
mStmt 
                              ,liqCredit :: LiqFacility -> Maybe Balance
liqCredit = Maybe Balance
mCredit
                              ,liqCreditCalc :: LiqFacility -> Maybe LiqCreditCalc
liqCreditCalc = Maybe LiqCreditCalc
mCreditType
                              ,liqDueInt :: LiqFacility -> Balance
liqDueInt = Balance
liqDueInt
                              ,liqDuePremium :: LiqFacility -> Balance
liqDuePremium = Balance
liqDuePremium
                              ,liqType :: LiqFacility -> LiqSupportType
liqType = LiqSupportType
lt} 
  = LiqFacility
liq {liqBalance = newBal ,liqCredit = newCredit ,liqDueInt = newIntDue
         ,liqDuePremium = newDuePremium ,liqStmt = newStmt}
    where 
      (Balance
newBal, Balance
newIntDue, Balance
newDuePremium) = 
        case LiqRepayType
pt of 
          LiqRepayType
LiqBal -> ( Balance
liqBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
amt, Balance
liqDueInt, Balance
liqDuePremium )
          LiqRepayType
LiqPremium -> ( Balance
liqBal , Balance
liqDueInt,   Balance
liqDuePremium  Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
amt )
          LiqRepayType
LiqInt -> ( Balance
liqBal , Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
max Balance
0 (Balance
liqDueInt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
amt), Balance
liqDuePremium )
          LiqRepayType
_ -> ( Balance
liqBal, Balance
liqDueInt, Balance
liqDuePremium )

      newCredit :: Maybe Balance
newCredit = case (Maybe LiqCreditCalc
mCreditType,LiqRepayType
pt) of
                    (Maybe LiqCreditCalc
_ , LiqRepayType
LiqOD) -> (Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
amt) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit
                    (Maybe LiqCreditCalc
Nothing, LiqRepayType
_) -> Maybe Balance
mCredit
                    (Just LiqCreditCalc
IncludeDueInt, LiqRepayType
LiqInt) -> (Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
amt) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit
                    (Just LiqCreditCalc
IncludeDuePremium, LiqRepayType
LiqPremium) -> (Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
amt) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit
                    (Just LiqCreditCalc
IncludeBoth, LiqRepayType
LiqInt) -> (Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
amt) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit
                    (Just LiqCreditCalc
IncludeBoth, LiqRepayType
LiqPremium) -> (Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
amt) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit
                    (Maybe LiqCreditCalc, LiqRepayType)
_ -> Maybe Balance
mCredit

      newStmt :: Maybe Statement
newStmt = Txn -> Maybe Statement -> Maybe Statement
appendStmt (Date
-> Maybe Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> TxnComment
-> Txn
SupportTxn Date
d Maybe Balance
newCredit Balance
newBal Balance
newIntDue Balance
newDuePremium Balance
amt  (String -> TxnComment
LiquidationRepay (LiqRepayType -> String
forall a. Show a => a -> String
show LiqRepayType
pt))) Maybe Statement
mStmt  

-- | accure fee and interest of a liquidity provider and update credit available
accrueLiqProvider ::  Date -> LiqFacility -> LiqFacility
accrueLiqProvider :: Date -> LiqFacility -> LiqFacility
accrueLiqProvider Date
d liq :: LiqFacility
liq@(LiqFacility String
_ LiqSupportType
_ Balance
curBal Maybe Balance
mCredit Maybe LiqCreditCalc
_ Maybe RateType
mRateType Maybe RateType
mPRateType Maybe IRate
rate Maybe IRate
prate Maybe Date
dueDate Balance
dueInt Balance
duePremium Date
sd Maybe Date
mEd Maybe Statement
Nothing)
  = Date -> LiqFacility -> LiqFacility
accrueLiqProvider Date
d (LiqFacility -> LiqFacility) -> LiqFacility -> LiqFacility
forall a b. (a -> b) -> a -> b
$ LiqFacility
liq{liqStmt = Just defaultStmt} 
    where 
      -- insert begining record
      defaultStmt :: Statement
defaultStmt = DList Txn -> Statement
Statement (DList Txn -> Statement) -> DList Txn -> Statement
forall a b. (a -> b) -> a -> b
$ Txn -> DList Txn
forall a. a -> DList a
DL.singleton (Txn -> DList Txn) -> Txn -> DList Txn
forall a b. (a -> b) -> a -> b
$ Date
-> Maybe Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> TxnComment
-> Txn
SupportTxn Date
sd Maybe Balance
mCredit Balance
curBal Balance
dueInt Balance
duePremium Balance
0 TxnComment
Empty

accrueLiqProvider Date
d liq :: LiqFacility
liq@(LiqFacility String
_ LiqSupportType
_ Balance
curBal Maybe Balance
mCredit Maybe LiqCreditCalc
mCreditType Maybe RateType
mRateType Maybe RateType
mPRateType Maybe IRate
rate Maybe IRate
prate Maybe Date
dueDate Balance
dueInt Balance
duePremium Date
sd Maybe Date
mEd mStmt :: Maybe Statement
mStmt@(Just (Statement DList Txn
txns)))
  = LiqFacility
liq { liqStmt = newStmt
         ,liqDueInt = newDueInt
         ,liqDuePremium = newDueFee
         ,liqCredit = newCredit 
         ,liqDueIntDate = Just d
         }
    where 
      lastAccDate :: Date
lastAccDate = Date -> Maybe Date -> Date
forall a. a -> Maybe a -> a
fromMaybe Date
sd Maybe Date
dueDate
      accureInt :: Balance
accureInt = case Maybe IRate
rate of 
                    Maybe IRate
Nothing -> Balance
0
                    Just IRate
r -> 
                      let 
                        bals :: [Balance]
bals = Dates -> [Txn] -> [Balance]
weightAvgBalanceByDates [Date
lastAccDate,Date
d] (DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList DList Txn
txns)
                      in 
                        [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ (Balance -> IRate -> Balance) -> IRate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> IRate -> Balance
mulBIR IRate
r (Balance -> Balance) -> [Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Balance]
bals -- `debug` ("Accure Using Rate"++show r++"avg bal"++ show bals ++"ds"++show [lastAccDate,d])
      accureFee :: Balance
accureFee = case Maybe IRate
prate of
                    Maybe IRate
Nothing -> Balance
0 
                    Just IRate
r -> 
                      let 
                        ([Txn]
_,[Txn]
_unAccTxns) = [Txn] -> Date -> SplitType -> ([Txn], [Txn])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate (DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList DList Txn
txns) Date
lastAccDate SplitType
EqToLeftKeepOne
                        accBals :: [Balance]
accBals = Txn -> Balance
getUnusedBal (Txn -> Balance) -> [Txn] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
_unAccTxns 
                        _ds :: Dates
_ds = Date
lastAccDate Date -> Dates -> Dates
forall a. a -> [a] -> [a]
: Dates -> Dates
forall a. HasCallStack => [a] -> [a]
tail (Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (Txn -> Date) -> [Txn] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
_unAccTxns)
                        _avgBal :: Balance
_avgBal = DayCount -> [Balance] -> Dates -> Balance
calcWeightBalanceByDates DayCount
DC_ACT_365F [Balance]
accBals (Dates
_dsDates -> Dates -> Dates
forall a. [a] -> [a] -> [a]
++[Date
d])
                      in 
                        Balance -> IRate -> Balance
mulBIR Balance
_avgBal IRate
r
                        
      getUnusedBal :: Txn -> Balance
getUnusedBal (SupportTxn Date
_ Maybe Balance
b Balance
_ Balance
_ Balance
_ Balance
_ TxnComment
_) = Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe Balance
0 Maybe Balance
b 
      
      newDueFee :: Balance
newDueFee = Balance
accureFee Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
duePremium
      newDueInt :: Balance
newDueInt = Balance
accureInt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
dueInt
      newCredit :: Maybe Balance
newCredit = case Maybe LiqCreditCalc
mCreditType of 
                    Maybe LiqCreditCalc
Nothing -> Maybe Balance
mCredit
                    Just LiqCreditCalc
IncludeDueInt -> (\Balance
x -> Balance
x Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accureInt) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit
                    Just LiqCreditCalc
IncludeDuePremium -> (\Balance
x -> Balance
x Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accureFee) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit
                    Just LiqCreditCalc
IncludeBoth -> (\Balance
x -> Balance
x Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accureInt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accureFee) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mCredit

      newStmt :: Maybe Statement
newStmt = Txn -> Maybe Statement -> Maybe Statement
appendStmt (Date
-> Maybe Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> TxnComment
-> Txn
SupportTxn Date
d Maybe Balance
newCredit Balance
curBal Balance
newDueInt Balance
newDueFee Balance
0 (Balance -> Balance -> TxnComment
LiquidationSupportInt Balance
accureInt Balance
accureFee)) Maybe Statement
mStmt 


instance QueryByComment LiqFacility where 
    queryStmt :: LiqFacility -> TxnComment -> [Txn]
queryStmt liq :: LiqFacility
liq@LiqFacility{liqStmt :: LiqFacility -> Maybe Statement
liqStmt = Maybe Statement
Nothing} TxnComment
tc = []
    queryStmt liq :: LiqFacility
liq@LiqFacility{liqStmt :: LiqFacility -> Maybe Statement
liqStmt = (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 LiqFacility where 
  isPaidOff :: LiqFacility -> Bool
isPaidOff liq :: LiqFacility
liq@LiqFacility{liqBalance :: LiqFacility -> Balance
liqBalance=Balance
bal,liqDueInt :: LiqFacility -> Balance
liqDueInt=Balance
dueInt,liqDuePremium :: LiqFacility -> Balance
liqDuePremium=Balance
duePremium}
    | Balance
balBalance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
==Balance
0 Bool -> Bool -> Bool
&& Balance
dueIntBalance -> 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

  getCurBalance :: LiqFacility -> Balance
getCurBalance LiqFacility{liqBalance :: LiqFacility -> Balance
liqBalance = Balance
bal} = Balance
bal

  getDueInt :: LiqFacility -> Balance
getDueInt LiqFacility{liqDueInt :: LiqFacility -> Balance
liqDueInt = Balance
dueInt} = Balance
dueInt

  getOutstandingAmount :: LiqFacility -> Balance
getOutstandingAmount LiqFacility{liqBalance :: LiqFacility -> Balance
liqBalance = Balance
bal,liqDueInt :: LiqFacility -> Balance
liqDueInt = Balance
dueInt,liqDuePremium :: LiqFacility -> Balance
liqDuePremium = Balance
duePremium} = Balance
bal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
dueInt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
duePremium

  getOriginBalance :: LiqFacility -> Balance
getOriginBalance LiqFacility{liqBalance :: LiqFacility -> Balance
liqBalance = Balance
bal} = Balance
0 

instance IR.UseRate LiqFacility where 
  getIndexes :: LiqFacility -> Maybe [Index]
getIndexes liq :: LiqFacility
liq@LiqFacility{liqRateType :: LiqFacility -> Maybe RateType
liqRateType = Maybe RateType
mRt,liqPremiumRateType :: LiqFacility -> Maybe RateType
liqPremiumRateType = Maybe RateType
mPrt} 
    = case (Maybe RateType
mRt,Maybe RateType
mPrt) of 
        (Maybe RateType
Nothing, Maybe RateType
Nothing) -> Maybe [Index]
forall a. Maybe a
Nothing
        (Just (IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_), Maybe RateType
Nothing ) -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx]
        (Maybe RateType
Nothing, Just (IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_)) -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx]
        (Just (IR.Floater DayCount
_ Index
idx1 IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_), Just (IR.Floater DayCount
_ Index
idx2 IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_)) -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx1,Index
idx2]
        (Maybe RateType, Maybe RateType)
_ -> Maybe [Index]
forall a. Maybe a
Nothing

  isAdjustbleRate :: LiqFacility -> Bool
isAdjustbleRate liq :: LiqFacility
liq@LiqFacility{liqRateType :: LiqFacility -> Maybe RateType
liqRateType = Maybe RateType
mRt,liqPremiumRateType :: LiqFacility -> Maybe RateType
liqPremiumRateType = Maybe RateType
mPrt} 
    = case (Maybe RateType
mRt,Maybe RateType
mPrt) of 
        (Just (IR.Floater {}), Maybe RateType
_ ) -> Bool
True
        (Maybe RateType
_, Just (IR.Floater {})) -> Bool
True
        (Maybe RateType, Maybe RateType)
_ -> Bool
False

  getIndex :: LiqFacility -> Maybe Index
getIndex LiqFacility
liq = [Index] -> Index
forall a. HasCallStack => [a] -> a
head ([Index] -> Index) -> Maybe [Index] -> Maybe Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LiqFacility -> Maybe [Index]
forall x. UseRate x => x -> Maybe [Index]
IR.getIndexes LiqFacility
liq

data CreditDefaultSwap = CDS {
    CreditDefaultSwap -> String
cdsName :: String
    ,CreditDefaultSwap -> Maybe DatePattern
cdsAccrue :: Maybe DatePattern

    ,CreditDefaultSwap -> DealStats
cdsCoverage :: DealStats     -- ^ the coverage 
    ,CreditDefaultSwap -> Balance
cdsDue :: Balance           -- ^ the amount to collect from CDS,paid to SPV as cure to loss incurred by SPV 
    ,CreditDefaultSwap -> Maybe Date
cdsLast :: Maybe Date       -- ^ last date of Due calc

    ,CreditDefaultSwap -> DealStats
cdsPremiumRefBalance :: DealStats  -- ^ how notional balance is calculated
    ,CreditDefaultSwap -> IRate
cdsPremiumRate :: IRate            -- ^ the rate to calculate premium
    ,CreditDefaultSwap -> RateType
cdsRateType :: IR.RateType         -- ^ interest rate type 
    
    ,CreditDefaultSwap -> Balance
cdsPremiumDue :: Balance           -- ^ the due premium to payout from SPV
    ,CreditDefaultSwap -> Maybe Date
cdsLastCalcDate :: Maybe Date      -- ^ last calculate date on net cash 

    ,CreditDefaultSwap -> Maybe DatePattern
cdsSettle :: Maybe DatePattern
    ,CreditDefaultSwap -> Maybe Date
cdsSettleDate :: Maybe Date       -- ^ last setttle date on net cash 
    ,CreditDefaultSwap -> Balance
cdsNetCash :: Balance             -- ^ the net cash to settle ,negative means SPV pay to CDS, positive means CDS pay to SPV

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

instance IR.UseRate CreditDefaultSwap where 
  getIndexes :: CreditDefaultSwap -> Maybe [Index]
getIndexes cds :: CreditDefaultSwap
cds@CDS{cdsRateType :: CreditDefaultSwap -> RateType
cdsRateType = RateType
rt} 
    = case RateType
rt of 
        (IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_) -> [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just [Index
idx]
        (IR.Fix DayCount
_ IRate
_) -> Maybe [Index]
forall a. Maybe a
Nothing


$(deriveJSON defaultOptions ''LiqRepayType)
$(deriveJSON defaultOptions ''LiqDrawType)
$(deriveJSON defaultOptions ''LiqSupportType)
$(deriveJSON defaultOptions ''LiqCreditCalc)
$(deriveJSON defaultOptions ''LiqFacility)