diff --git a/CHANGELOG.md b/CHANGELOG.md index 783a6490..9f54541f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,9 +3,18 @@ +## 0.40.13 +### 2024-12-17 +* NEW: new formula `totalFunded` for bond with extra funding amount +* NEW: new deal run assumption `FundBond`, which records a time series funding amount for a single bond. +* ENHANCE: When booking account from `support` action, now user can book on `Credit` or `Debit` side +* FIX: `payPrinBySeq` was not working + + + ## 0.40.9 ### 2024-12-11 -* ENHANCE: Ensure always return positive ,otherwise engine will throw error +* ENHANCE: Ensure `limit` always return positive ,otherwise engine will throw error * NEW: add new action `changeStatus` in waterfall, with optional `Pre` as condition to trigger the status change diff --git a/Hastructure.cabal b/Hastructure.cabal index d14b2a0e..d9883bea 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: Hastructure -version: 0.40.11 +version: 0.41.0 description: Please see the README on GitHub at category: StructuredFinance;Securitisation;Cashflow homepage: https://github.com/yellowbean/Hastructure#readme @@ -80,6 +80,7 @@ library , hashable , ieee754 , lens + , math-functions , monad-loops , numeric-limits , openapi3 @@ -124,6 +125,7 @@ executable Hastructure-exe , ieee754 , lens , lucid + , math-functions , monad-loops , mtl , numeric-limits @@ -189,6 +191,7 @@ test-suite Hastructure-test , hashable , ieee754 , lens + , math-functions , monad-loops , numeric-limits , openapi3 diff --git a/app/Main.hs b/app/Main.hs index 1e41867f..981c5003 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -115,7 +115,7 @@ $(deriveJSON defaultOptions ''Version) instance ToSchema Version version1 :: Version -version1 = Version "0.40.11" +version1 = Version "0.41.0" diff --git a/package.yaml b/package.yaml index 519e374c..c6b4b875 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: Hastructure -version: 0.40.11 +version: 0.41.0 github: "yellowbean/Hastructure" license: BSD3 author: "Xiaoyu" @@ -47,6 +47,7 @@ dependencies: - tabular - numeric-limits - scientific +- math-functions library: source-dirs: @@ -86,6 +87,7 @@ executables: - attoparsec - exceptions - tabular + - math-functions # - servant-errors # - servant-exceptions - servant-checked-exceptions diff --git a/src/Accounts.hs b/src/Accounts.hs index a6a319c4..e410bdf5 100644 --- a/src/Accounts.hs +++ b/src/Accounts.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RankNTypes #-} module Accounts (Account(..),ReserveAmount(..),draw,deposit - ,transfer,depositInt - ,InterestInfo(..),buildEarnIntAction,updateReserveBalance - ,accBalLens,tryDraw,buildRateResetDates,accrueInt) + ,transfer,depositInt ,InterestInfo(..),buildEarnIntAction + ,accBalLens,tryDraw,buildRateResetDates,accrueInt,accTypeLens) where import qualified Data.Time as T import Stmt (Statement(..),appendStmt,getTxnBegBalance,getDate @@ -19,8 +19,9 @@ import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types import GHC.Generics +import Control.Lens.Tuple -import Control.Lens +import Control.Lens hiding (Index) import qualified InterestRate as IR @@ -33,10 +34,6 @@ data InterestInfo = BankAccount IRate DatePattern Date -- ^ float type: index, spread, sweep dates, rate reset , last accrue day, last reset rate deriving (Show, Generic,Eq,Ord) - -makePrisms ''InterestInfo - - data ReserveAmount = PctReserve DealStats Rate -- ^ target amount with reference to % of formula | FixReserve Balance -- ^ target amount with fixed balance amount | Either Pre ReserveAmount ReserveAmount -- ^ target amount depends on a test, if true, then use first one ,otherwise use second one @@ -68,15 +65,15 @@ accrueInt _ (Account _ _ Nothing _ _) = 0 -- ^ bank account type interest accrueInt endDate a@(Account bal _ (Just interestType) _ stmt) = case stmt of - Nothing -> mulBR (mulBI bal rateToUse) (yearCountFraction defaultDc lastDay endDate) -- `debug` (">>"++show lastCollectDate++">>"++show ed) - Just (Statement txns) -> - let - accrueTxns = sliceBy IE lastDay endDate txns - bals = map getTxnBegBalance accrueTxns ++ [bal] - ds = [lastDay] ++ getDates accrueTxns ++ [endDate] - avgBal = calcWeightBalanceByDates defaultDc bals ds - in - mulBI avgBal rateToUse + Nothing -> mulBR (mulBI bal rateToUse) (yearCountFraction defaultDc lastDay endDate) -- `debug` (">>"++show lastCollectDate++">>"++show ed) + Just (Statement txns) -> + let + accrueTxns = sliceBy IE lastDay endDate txns + bals = map getTxnBegBalance accrueTxns ++ [bal] + ds = [lastDay] ++ getDates accrueTxns ++ [endDate] + avgBal = calcWeightBalanceByDates defaultDc bals ds + in + mulBI avgBal rateToUse where defaultDc = DC_30E_360 (lastDay,rateToUse) = case interestType of @@ -87,7 +84,7 @@ accrueInt endDate a@(Account bal _ (Just interestType) _ stmt) depositInt :: Date -> Account -> Account depositInt _ a@(Account _ _ Nothing _ _) = a depositInt ed a@(Account bal _ (Just intType) _ stmt) - = a {accBalance = newBal ,accStmt= newStmt ,accInterest = Just (newIntInfoType intType)} + = a {accBalance = newBal ,accStmt= appendStmt newTxn stmt ,accInterest = Just (newIntInfoType intType)} where -- accruedInt = accrueInt a (mkTs [(lastCollectDate, toRational r),(ed, toRational r)]) ed accruedInt = accrueInt ed a @@ -95,7 +92,6 @@ depositInt ed a@(Account bal _ (Just intType) _ stmt) newIntInfoType (InvestmentAccount x y z z1 _d z2) = (InvestmentAccount x y z z1 ed z2) newBal = accruedInt + bal -- `debug` ("INT ACC->"++ show accrued_int) newTxn = AccTxn ed newBal accruedInt BankInt - newStmt = appendStmt stmt newTxn -- | move cash from account A to account B transfer :: (Account,Account) -> Date -> Amount -> (Account, Account) @@ -107,16 +103,16 @@ transfer (sourceAcc@(Account sBal san _ _ sStmt), targetAcc@(Account tBal tan _ where newSBal = sBal - amount newTBal = tBal + amount - sourceNewStmt = appendStmt sStmt (AccTxn d newSBal (- amount) (Transfer san tan)) - targetNewStmt = appendStmt tStmt (AccTxn d newTBal amount (Transfer san tan) ) + sourceNewStmt = appendStmt (AccTxn d newSBal (- amount) (Transfer san tan)) sStmt + targetNewStmt = appendStmt (AccTxn d newTBal amount (Transfer san tan)) tStmt -- | deposit cash to account with a comment deposit :: Amount -> Date -> TxnComment -> Account -> Account deposit amount d source acc@(Account bal _ _ _ maybeStmt) = acc {accBalance = newBal, accStmt = newStmt} where - newBal = bal + amount -- `debug` ("Date:"++show d++ "deposit"++show amount++"from"++show bal) - newStmt = appendStmt maybeStmt (AccTxn d newBal amount source) + newBal = bal + amount + newStmt = appendStmt (AccTxn d newBal amount source) maybeStmt -- | draw cash from account with a comment draw :: Amount -> Date -> TxnComment -> Account -> Account @@ -131,20 +127,10 @@ tryDraw amt d tc acc@(Account bal _ _ _ maybeStmt) | otherwise = ((0, amt), draw amt d tc acc) --- | change reserve target info of account -updateReserveBalance :: ReserveAmount -> Account -> Account -updateReserveBalance ra acc = acc {accType = Just ra} - instance QueryByComment Account where queryStmt (Account _ _ _ _ Nothing) tc = [] queryStmt (Account _ _ _ _ (Just (Statement txns))) tc = filter (\x -> getTxnComment x == tc) txns --- | query total balance transfer from account a to account b -queryTrasnferBalance :: Account -> Account -> Balance -queryTrasnferBalance Account{accStmt = Nothing } Account{accName = an} = 0 -queryTrasnferBalance a@Account{accName = fromAccName, accStmt = Just (Statement txns)} Account{accName = toAccName} - = sum $ getTxnAmt <$> queryStmt a (Transfer fromAccName toAccName) - -- InvestmentAccount Types.Index Spread DatePattern DatePattern Date IRate buildRateResetDates :: Date -> Account -> Maybe (String,Dates) @@ -154,7 +140,7 @@ buildRateResetDates _ _ = Nothing makeLensesFor [("accBalance","accBalLens") ,("accName","accNameLens") - ,("accType","accTypeLens") ,("accStmt","accStmtLens")] ''Account + ,("accType","accTypeLens") ,("accStmt","accStmtLens"),("accInterest","accIntLens")] ''Account instance IR.UseRate Account where @@ -165,6 +151,7 @@ instance IR.UseRate Account where getIndex _ = Nothing +makePrisms ''InterestInfo $(deriveJSON defaultOptions ''InterestInfo) $(deriveJSON defaultOptions ''ReserveAmount) diff --git a/src/Analytics.hs b/src/Analytics.hs index 76127be9..33d93b82 100644 --- a/src/Analytics.hs +++ b/src/Analytics.hs @@ -3,7 +3,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables #-} -module Analytics (calcDuration,pv,calcWAL,pv2,pv3,fv2,pv21) +module Analytics (calcDuration,pv,calcWAL,pv2,pv3,fv2,pv21,calcRequiredAmtForIrrAtDate) + where import Types import Lib @@ -15,6 +16,7 @@ import Data.Aeson.TH import Data.Aeson.Types import GHC.Generics import Data.Ratio +import Numeric.RootFinding import Debug.Trace debug = flip trace @@ -24,8 +26,8 @@ calcWAL :: TimeHorizion -> Balance -> Date -> [(Balance,Date)] -> Balance calcWAL th bal d ps = let interval = case th of - ByYear -> 365 - ByMonth -> 30 + ByYear -> 365 + ByMonth -> 30 weightedAmts = [ mulBR futureAmt ((daysBetween d futureDate) % interval) | (futureAmt,futureDate) <- ps ] in sum weightedAmts / bal @@ -48,18 +50,21 @@ pv :: Ts -> Date -> Date -> Amount -> Amount pv pc today d amt = realToFrac $ (realToFrac amt) * (1 / factor) -- `debug` ("DF:"++show factor++" PV AMT"++show amt) where - distance::Double = fromIntegral $ daysBetween today d - discount_rate = fromRational $ getValByDate pc Exc d -- `debug` ("Get val by ts"++show pc ++">>d"++ show d) - factor::Double = (1 + realToFrac discount_rate) ** (distance / 365) -- `debug` ("discount_rate"++show(discount_rate) ++" dist days=>"++show(distance)) + distance::Double = fromIntegral $ daysBetween today d + discount_rate = fromRational $ getValByDate pc Exc d -- `debug` ("Get val by ts"++show pc ++">>d"++ show d) + factor::Double = (1 + realToFrac discount_rate) ** (distance / 365) -- `debug` ("discount_rate"++show(discount_rate) ++" dist days=>"++show(distance)) -- ^ calculate present value in the future using constant rate pv2 :: IRate -> Date -> Date -> Amount -> Amount -pv2 discount_rate today d amt = - realToFrac $ (realToFrac amt) * (1/denominator) -- `debug` ("pv: cash"++ show amt++" deno"++ show denominator++">> rate"++show discount_rate) - where - denominator::Double = (1 + realToFrac discount_rate) ** (distance / 365) - distance::Double = fromIntegral $ daysBetween today d -- `debug` ("days betwwen"++ show (daysBetween today d)++">>"++ show d ++ ">>today>>"++ show today) +pv2 discount_rate today d amt + | today == d = amt + | otherwise + = realToFrac $ (realToFrac amt) * (1/denominator) -- `debug` ("pv: cash"++ show amt++" deno"++ show denominator++">> rate"++show discount_rate) + where + denominator::Double = (1 + realToFrac discount_rate) ** (distance / 365) + distance::Double = fromIntegral $ daysBetween today d -- `debug` ("days betwwen"++ show (daysBetween today d)++">>"++ show d ++ ">>today>>"++ show today) +-- ^ calculate present value to specific date given a series of amount with dates pv21 :: IRate -> Date -> [Date] -> [Amount] -> Balance pv21 r d ds vs = sum [ pv2 r d _d amt | (_d,amt) <- zip ds vs ] @@ -78,4 +83,30 @@ fv2 discount_rate today futureDay amt = realToFrac $ realToFrac amt * factor where factor::Double = (1 + realToFrac discount_rate) ** (distance / 365) - distance::Double = fromIntegral $ daysBetween today futureDay \ No newline at end of file + distance::Double = fromIntegral $ daysBetween today futureDay + + +calcPvFromIRR :: Double -> [Date] -> [Amount] -> Date -> Double -> Double +calcPvFromIRR irr [] _ d amt = 0 +calcPvFromIRR irr ds vs d amt = + let + begDate = head ds + pv = pv21 ((fromRational . toRational) irr) begDate (ds++[d]) (vs++[ (fromRational . toRational) amt ]) + in + (fromRational . toRational) pv + +-- IRR + +-- ^ calculate IRR of a series of cashflow +calcRequiredAmtForIrrAtDate :: Double -> [Date] -> [Amount] -> Date -> Maybe Amount +calcRequiredAmtForIrrAtDate irr [] _ d = Nothing +calcRequiredAmtForIrrAtDate irr ds vs d = + let + def = RiddersParam + { riddersMaxIter = 200 + , riddersTol = RelTol 0.00000001 + } + in + case ridders def (0.0001,100000000000000) (calcPvFromIRR irr ds vs d) of + Root finalAmt -> Just (fromRational (toRational finalAmt)) + _ -> Nothing diff --git a/src/Asset.hs b/src/Asset.hs index 60b00be0..387d5679 100644 --- a/src/Asset.hs +++ b/src/Asset.hs @@ -6,12 +6,11 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-} -module Asset ( Asset(..) - ,calcPiFlow - ,buildAssumptionPpyDefRecRate,buildAssumptionPpyDelinqDefRecRate +module Asset ( Asset(..), + buildAssumptionPpyDefRecRate,buildAssumptionPpyDelinqDefRecRate ,calcRecoveriesFromDefault ,priceAsset,applyHaircut,buildPrepayRates,buildDefaultRates,getObligorFields - ,getObligorTags,getObligorId + ,getObligorTags,getObligorId,getRecoveryLagAndRate,getDefaultDelinqAssump ) where import qualified Data.Time as T @@ -97,12 +96,12 @@ class (Show a,IR.UseRate a) => Asset a where -- | ! Internal use calcAlignDate :: a -> Date -> Date calcAlignDate ast d = let - payDates = getOriginDate ast:getPaymentDates ast 0 + payDates = Asset.getOriginDate ast:getPaymentDates ast 0 remainTerms = getRemainTerms ast benchDate = reverse payDates!! remainTerms offset = daysBetween benchDate d in - T.addDays offset $ getOriginDate ast + T.addDays offset $ Asset.getOriginDate ast getObligor :: a -> Maybe Obligor getObligor a = @@ -157,87 +156,94 @@ applyExtraStress (Just ExtraStress{A.defaultFactors= mDefFactor ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor) -buildPrepayRates :: [Date] -> Maybe A.AssetPrepayAssumption -> [Rate] -buildPrepayRates ds Nothing = replicate (pred (length ds)) 0.0 +buildPrepayRates :: [Date] -> Maybe A.AssetPrepayAssumption -> Either String [Rate] +buildPrepayRates ds Nothing = Right $ replicate (pred (length ds)) 0.0 buildPrepayRates ds mPa = case mPa of - Just (A.PrepaymentConstant r) -> replicate size r - Just (A.PrepaymentCPR r) -> Util.toPeriodRateByInterval r <$> getIntervalDays ds - Just (A.PrepaymentVec vs) -> zipWith + Just (A.PrepaymentConstant r) -> Right $ replicate size r + Just (A.PrepaymentCPR r) -> Right $ Util.toPeriodRateByInterval r <$> getIntervalDays ds + Just (A.PrepaymentVec vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault 0.0 vs (pred size)) (getIntervalDays ds) - Just (A.PrepaymentVecPadding vs) -> zipWith + Just (A.PrepaymentVecPadding vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault (last vs) vs (pred size)) (getIntervalDays ds) Just (A.PrepayStressByTs ts x) -> - let - rs = buildPrepayRates ds (Just x) - in - getTsVals $ multiplyTs Exc (zipTs (tail ds) rs) ts + do + rs <- buildPrepayRates ds (Just x) + return $ getTsVals $ multiplyTs Exc (zipTs (tail ds) rs) ts - _ -> error ("failed to find prepayment type"++ show mPa) + _ -> Left ("failed to find prepayment type"++ show mPa) where size = length ds -buildDefaultRates :: [Date] -> Maybe A.AssetDefaultAssumption -> [Rate] -buildDefaultRates ds Nothing = replicate (pred (length ds)) 0.0 +buildDefaultRates :: [Date] -> Maybe A.AssetDefaultAssumption -> Either String [Rate] +buildDefaultRates ds Nothing = Right $ replicate (pred (length ds)) 0.0 buildDefaultRates ds mDa = case mDa of - Just (A.DefaultConstant r) -> replicate size r - Just (A.DefaultCDR r) -> Util.toPeriodRateByInterval r <$> getIntervalDays ds - Just (A.DefaultVec vs) -> zipWith + Just (A.DefaultConstant r) -> Right $ replicate size r + Just (A.DefaultCDR r) -> Right $ Util.toPeriodRateByInterval r <$> getIntervalDays ds + Just (A.DefaultVec vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault 0.0 vs (pred size)) (getIntervalDays ds) - Just (A.DefaultVecPadding vs) -> zipWith + Just (A.DefaultVecPadding vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault (last vs) vs (pred size)) (getIntervalDays ds) Just (A.DefaultAtEndByRate r rAtEnd) - -> case size of + -> Right $ case size of 0 -> [] 1 -> [] _ -> (Util.toPeriodRateByInterval r <$> getIntervalDays (init ds)) ++ (Util.toPeriodRateByInterval rAtEnd <$> getIntervalDays [head ds,last ds]) Just (A.DefaultStressByTs ts x) -> - let - rs = buildDefaultRates ds (Just x) - r = getTsVals $ multiplyTs Inc (zipTs (tail ds) rs) ts - in - r -- `debug` ("Default Stress"++ show [ (fromRational x)::Float | x <- r] ) - _ -> error ("failed to find prepayment type"++ show mDa) + do + rs <- buildDefaultRates ds (Just x) + let r = getTsVals $ multiplyTs Inc (zipTs (tail ds) rs) ts + return r + _ -> Left ("failed to find default rate type"++ show mDa) where size = length ds +getRecoveryLagAndRate :: Maybe A.RecoveryAssumption -> (Rate,Int) +getRecoveryLagAndRate Nothing = (0,0) +getRecoveryLagAndRate (Just (A.Recovery (r,lag))) = (r,lag) -- | build pool assumption rate (prepayment, defaults, recovery rate , recovery lag) -buildAssumptionPpyDefRecRate :: [Date] -> A.AssetPerfAssumption -> ([Rate],[Rate],Rate,Int) +buildAssumptionPpyDefRecRate :: [Date] -> A.AssetPerfAssumption -> Either String ([Rate],[Rate],Rate,Int) buildAssumptionPpyDefRecRate ds (A.LoanAssump mDa mPa mRa mESa) = buildAssumptionPpyDefRecRate ds (A.MortgageAssump mDa mPa mRa mESa) buildAssumptionPpyDefRecRate ds (A.MortgageAssump mDa mPa mRa mESa) - = (prepayRates2,defaultRates2,recoveryRate,recoveryLag) - where + = let size = length ds zeros = replicate size 0.0 - prepayRates = buildPrepayRates ds mPa - defaultRates = buildDefaultRates ds mDa - (recoveryRate,recoveryLag) = case mRa of - Nothing -> (0,0) - Just (A.Recovery (r,lag)) -> (r,lag) + (recoveryRate,recoveryLag) = getRecoveryLagAndRate mRa + in + do + prepayRates <- buildPrepayRates ds mPa + defaultRates <- buildDefaultRates ds mDa + let (prepayRates2,defaultRates2) = applyExtraStress mESa ds prepayRates defaultRates + return (prepayRates2,defaultRates2,recoveryRate,recoveryLag) + + +getDefaultDelinqAssump :: Maybe A.AssetDelinquencyAssumption -> [Date] -> ([Rate],Int,Rate) +getDefaultDelinqAssump Nothing ds = (replicate (length ds) 0.0, 0, 0.0) +getDefaultDelinqAssump (Just (A.DelinqCDR r (lag,pct))) ds = (map (Util.toPeriodRateByInterval r) (getIntervalDays ds) + ,lag + ,pct) - (prepayRates2,defaultRates2) = applyExtraStress mESa ds prepayRates defaultRates +getDefaultLagAndRate :: Maybe A.RecoveryAssumption -> (Rate,Int) +getDefaultLagAndRate Nothing = (0,0) +getDefaultLagAndRate (Just (A.Recovery (r,lag))) = (r,lag) -- | build prepayment rates/ delinq rates and (%,lag) convert to default, recovery rate, recovery lag -buildAssumptionPpyDelinqDefRecRate :: [Date] -> A.AssetPerfAssumption -> ([Rate],[Rate],(Rate,Lag),Rate,Int) -buildAssumptionPpyDelinqDefRecRate ds (A.MortgageDeqAssump mDeqDefault mPa mRa (Just _)) = error "Delinq assumption doesn't support extra stress" +buildAssumptionPpyDelinqDefRecRate :: [Date] -> A.AssetPerfAssumption -> Either String ([Rate],[Rate],(Rate,Lag),Rate,Int) +buildAssumptionPpyDelinqDefRecRate ds (A.MortgageDeqAssump mDeqDefault mPa mRa (Just _)) = Left "Delinq assumption doesn't support extra stress" buildAssumptionPpyDelinqDefRecRate ds (A.MortgageDeqAssump mDeqDefault mPa mRa Nothing) - = (prepayRates,delinqRates,(defaultPct,defaultLag),recoveryRate, recoveryLag) - where - prepayRates = buildPrepayRates ds mPa - (recoveryRate,recoveryLag) = case mRa of - Nothing -> (0,0) - Just (A.Recovery (r,lag)) -> (r,lag) + = let + (recoveryRate,recoveryLag) = getRecoveryLagAndRate mRa zeros = replicate (length ds) 0.0 (delinqRates,defaultLag,defaultPct) = case mDeqDefault of Nothing -> (zeros,0,0.0) @@ -245,33 +251,10 @@ buildAssumptionPpyDelinqDefRecRate ds (A.MortgageDeqAssump mDeqDefault mPa mRa N (map (Util.toPeriodRateByInterval r) (getIntervalDays ds) ,lag ,pct) - - --- calculate Level P&I type mortgage cashflow -_calcPiFlow :: Amount -> Balance -> [Balance] -> [Amount] -> [Amount] -> [IRate] -> [Bool] -> ([Balance],CF.Principals,CF.Interests) -_calcPiFlow pmt last_bal bals ps is [] _ = (bals,ps,is) -_calcPiFlow pmt last_bal bals ps is (r:rs) (flag:flags) - | last_bal < 0.01 = (bals,ps,is) - | otherwise - = _calcPiFlow pmt new_bal (bals++[new_bal]) (ps++[new_prin]) (is++[new_int]) rs flags - where - new_int = mulBI last_bal r - new_prin = pmt - new_int - new_bal = last_bal - new_prin - new_pmt = if flag then - calcPmt new_bal (head rs) (length rs) - else - pmt - --- Dates -> include begining balance --- Rates -> length Dates - 1 -calcPiFlow :: DayCount -> Balance -> Amount -> [Date] -> [IRate] -> ([Balance],CF.Principals,CF.Interests) -calcPiFlow dc bal pmt dates rs = - _calcPiFlow pmt bal [] [] [] period_r resetFlags - where - size = length dates - resetFlags = A.calcResetDates rs [] - period_r = [ IR.calcIntRate (dates!!d) (dates!!(d+1)) (rs!!d) dc | d <- [0..size-2]] + in + do + prepayRates <- buildPrepayRates ds mPa + return (prepayRates,delinqRates,(defaultPct,defaultLag),recoveryRate, recoveryLag) calcRecoveriesFromDefault :: Balance -> Rate -> [Rate] -> [Amount] @@ -280,13 +263,12 @@ calcRecoveriesFromDefault bal recoveryRate recoveryTiming where recoveryAmt = mulBR bal recoveryRate - priceAsset :: Asset a => a -> Date -> PricingMethod -> A.AssetPerf -> Maybe [RateAssumption] -> CutoffType -> Either String PriceResult priceAsset m d (PVCurve curve) assumps mRates cType = let cr = getCurrentRate m - pDays = getOriginDate m:(getPaymentDates m 0) + pDays = Asset.getOriginDate m:(getPaymentDates m 0) cb = getCurrentBal m in case projCashflow m d assumps mRates of @@ -330,7 +312,7 @@ priceAsset m d (BalanceFactor currentFactor defaultedFactor) assumps mRates cTyp priceAsset m d (PvRate r) assumps mRates cType = let cb = getCurrentBal m - pDays = getOriginDate m:getPaymentDates m 0 + pDays = Asset.getOriginDate m:getPaymentDates m 0 cr = getCurrentRate m in case projCashflow m d assumps mRates of diff --git a/src/AssetClass/Installment.hs b/src/AssetClass/Installment.hs index 9d6092b9..6cb8e98f 100644 --- a/src/AssetClass/Installment.hs +++ b/src/AssetClass/Installment.hs @@ -131,8 +131,7 @@ instance Asset Installment where asOfDay pAssump@(A.InstallmentAssump defaultAssump prepayAssump recoveryAssump ams,_,_) mRates - = Right $ (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM) - where + = let recoveryLag = maybe 0 getRecoveryLag recoveryAssump lastPayDate:cfDates = lastN (rt + recoveryLag +1) $ sd:getPaymentDates inst recoveryLag @@ -145,13 +144,14 @@ instance Asset Installment where scheduleBalances = scanl (-) ob (replicate ot opmt) currentScheduleBal = scheduleBalances !! (ot - rt) -- `debug` ("RT->"++show rt) currentFactor = divideBB cb currentScheduleBal - - ppyRates = Ast.buildPrepayRates (lastPayDate:cfDates) prepayAssump - defRates = Ast.buildDefaultRates (lastPayDate:cfDates) defaultAssump - (txns,_) = projectInstallmentFlow (cb,lastPayDate,(opmt,ofee),orate,currentFactor,pt,ot) (cfDates,defRates,ppyRates,remainTerms) - (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns recoveryAssump) - begBal = CF.buildBegBal futureTxns - + in + do + ppyRates <- Ast.buildPrepayRates (lastPayDate:cfDates) prepayAssump + defRates <- Ast.buildDefaultRates (lastPayDate:cfDates) defaultAssump + let (txns,_) = projectInstallmentFlow (cb,lastPayDate,(opmt,ofee),orate,currentFactor,pt,ot) (cfDates,defRates,ppyRates,remainTerms) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns recoveryAssump) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM) -- ^ project with defaulted at a date projCashflow inst@(Installment (LoanOriginalInfo ob or ot p sd ptype _) cb rt (Defaulted (Just defaultedDate))) diff --git a/src/AssetClass/Loan.hs b/src/AssetClass/Loan.hs index 45f9cd31..4a63a0a4 100644 --- a/src/AssetClass/Loan.hs +++ b/src/AssetClass/Loan.hs @@ -127,26 +127,27 @@ instance Asset Loan where asOfDay (A.LoanAssump defaultAssump prepayAssump recoveryAssump ams,_,_) mRate - = Right $ (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM) - where - recoveryLag = maybe 0 getRecoveryLag recoveryAssump - lastPayDate:cfDates = lastN (rt + recoveryLag + 1) $ sd:getPaymentDates pl recoveryLag - rateVector = A.projRates cr or mRate cfDates - ppyRates = A.buildPrepayRates (lastPayDate:cfDates) prepayAssump - defRates = A.buildDefaultRates (lastPayDate:cfDates) defaultAssump - dc = getDayCount or - remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt] -- `debug` ("rateVector"++show rateVector) - initFactor = case prinPayType of - ScheduleRepayment ts _ -> - let - scheduleBals = scanl (-) ob $ fromRational <$> getTsVals ts - in - divideBB cb (scheduleBals!!(ot - rt)) - _ -> 1.0 - (txns,_) = projectLoanFlow ((ob,ot,getOriginRate pl), cb,lastPayDate,prinPayType,dc,cr,initFactor) (cfDates,defRates,ppyRates,rateVector,remainTerms) -- `debug` (" rateVector"++show rateVector) - (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns recoveryAssump) - begBal = CF.buildBegBal futureTxns - + = let + recoveryLag = maybe 0 getRecoveryLag recoveryAssump + lastPayDate:cfDates = lastN (rt + recoveryLag + 1) $ sd:getPaymentDates pl recoveryLag + in + do + rateVector <- A.projRates cr or mRate cfDates + ppyRates <- A.buildPrepayRates (lastPayDate:cfDates) prepayAssump + defRates <- A.buildDefaultRates (lastPayDate:cfDates) defaultAssump + let dc = getDayCount or + let remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt] -- `debug` ("rateVector"++show rateVector) + let initFactor = case prinPayType of + ScheduleRepayment ts _ -> + let + scheduleBals = scanl (-) ob $ fromRational <$> getTsVals ts + in + divideBB cb (scheduleBals!!(ot - rt)) + _ -> 1.0 + let (txns,_) = projectLoanFlow ((ob,ot,getOriginRate pl), cb,lastPayDate,prinPayType,dc,cr,initFactor) (cfDates,defRates,ppyRates,rateVector,remainTerms) -- `debug` (" rateVector"++show rateVector) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns recoveryAssump) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM) -- ^ Project cashflow for defautled loans projCashflow m@(PersonalLoan (LoanOriginalInfo ob or ot p sd prinPayType _) cb cr rt (Defaulted (Just defaultedDate))) asOfDay diff --git a/src/AssetClass/Mortgage.hs b/src/AssetClass/Mortgage.hs index db088c94..7e6800c4 100644 --- a/src/AssetClass/Mortgage.hs +++ b/src/AssetClass/Mortgage.hs @@ -239,7 +239,7 @@ projCashflowByDefaultAmt (cb,lastPayDate,pt,p,cr,mbn) (cfDates,(expectedDefaultB calcScheduleBalaceToday :: Mortgage -> Maybe [RateAssumption] -> Date -> Balance calcScheduleBalaceToday m mRates asOfDay = let - sd = getOriginDate m + sd = Ast.getOriginDate m in case calcCashflow (resetToOrig m) sd mRates of Right (CF.CashFlowFrame _ scheduleTxn) -> @@ -382,48 +382,50 @@ instance Ast.Asset Mortgage where asOfDay mars@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams ,_ ,_) mRates = - Right $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) - where + let recoveryLag = maybe 0 getRecoveryLag amr lastPayDate:cfDates = lastN (succ (recoveryLag + rt)) $ sd:getPaymentDates m recoveryLag - ppyRates = Ast.buildPrepayRates (lastPayDate:cfDates) amp - rateVector = A.projRates cr or mRates cfDates expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) (length cfDates) unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals remainTerms = paddingDefault 0 (reverse [0..(length cfDates - recoveryLag)]) (length cfDates) - txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn) - (cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms) - (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) - begBal = CF.buildBegBal futureTxns + in + do + rateVector <- A.projRates cr or mRates cfDates + ppyRates <- Ast.buildPrepayRates (lastPayDate:cfDates) amp + let txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn) + (cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) -- project current adjMortgage with total default amt projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current) asOfDay mars@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams,_,_) mRates = - Right $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) - where + let ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm passInitPeriod = (ot - rt) >= initPeriod firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) lastPayDate:cfDates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recoveryLag + 1) $ sd:getPaymentDates m recoveryLag - ppyRates = Ast.buildPrepayRates (lastPayDate:cfDates) amp rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates rateVector = fromRational <$> getValByDates rateCurve Inc cfDates expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) (length cfDates) unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals recoveryLag = maybe 0 getRecoveryLag amr remainTerms = paddingDefault 0 (reverse [0..(length cfDates - recoveryLag)]) (length cfDates) - txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn) (cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms) - (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) - begBal = CF.buildBegBal futureTxns - + in + do + ppyRates <- Ast.buildPrepayRates (lastPayDate:cfDates) amp + let txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn) (cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) -- project schedule cashflow with total default amount projCashflow (ScheduleMortgageFlow begDate flows dp) asOfDay assumps@(pAssump@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams ),dAssump,fAssump) _ - = Right $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCut,asOfDay,Nothing) futureTxns) ,historyM) -- `debug` ("Future txn"++ show futureTxns) - where + = let begBal = CF.mflowBegBalance $ head flows begDate = getDate $ head flows begRate = CF.mflowRate $ head flows @@ -432,49 +434,49 @@ instance Ast.Asset Mortgage where originFlowSize = length flows recoveryLag = maybe 0 getRecoveryLag amr totalLength = recoveryLag + originFlowSize - ppyRates = paddingDefault 0.0 (Ast.buildPrepayRates (begDate:originCfDates) amp) totalLength expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) totalLength unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals endDate = (CF.getDate . last) flows extraDates = genSerialDates dp Exc endDate recoveryLag flowsWithEx = flows ++ extendTxns (last flows) extraDates -- `debug` (">> end date"++ show endDate++">>> extra dates"++show extraDates) - (txns,_) = projScheduleCashflowByDefaultAmt - (begBal,begDate,begRate,begMbn) - (flowsWithEx,(expectedDefaultBals,unAppliedDefaultBals),ppyRates) -- `debug` ("exted flows"++ show flowsWithEx) - (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns amr) -- `debug` ("txn"++show txns) - begBalAfterCut = CF.buildBegBal futureTxns - + in + do + _ppyRate <- Ast.buildPrepayRates (begDate:originCfDates) amp + let ppyRates = paddingDefault 0.0 _ppyRate totalLength + let (txns,_) = projScheduleCashflowByDefaultAmt + (begBal,begDate,begRate,begMbn) + (flowsWithEx,(expectedDefaultBals,unAppliedDefaultBals),ppyRates) -- `debug` ("exted flows"++ show flowsWithEx) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns amr) -- `debug` ("txn"++show txns) + let begBalAfterCut = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCut,asOfDay,Nothing) futureTxns) ,historyM) -- `debug` ("Future txn"++ show futureTxns) -- project current mortgage(without delinq) projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current) asOfDay mars@(A.MortgageAssump amd amp amr ams ,_ ,_) mRates = - Right $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) - where + let recoveryLag = maybe 0 getRecoveryLag amr lastPayDate:cfDates = lastN (rt + 1) $ sd:getPaymentDates m 0 - - defRates = Ast.buildDefaultRates (lastPayDate:cfDates) amd - ppyRates = Ast.buildPrepayRates (lastPayDate:cfDates) amp - cfDatesLength = length cfDates - - rateVector = A.projRates cr or mRates cfDates - remainTerms = reverse [0..rt] dc = getDayCount or -- `debug` ("day count"++ show dc) - - (txns,_) = projectMortgageFlow - (ob, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot) - (cfDates, defRates, ppyRates,rateVector,remainTerms) - recoveryDates = lastN recoveryLag $ sd:getPaymentDates m recoveryLag - lastProjTxn = last txns - extraTxns = [ CF.emptyTsRow d lastProjTxn | d <- recoveryDates ] + in + do + rateVector <- A.projRates cr or mRates cfDates + defRates <- Ast.buildDefaultRates (lastPayDate:cfDates) amd + ppyRates <- Ast.buildPrepayRates (lastPayDate:cfDates) amp + let (txns,_) = projectMortgageFlow + (ob, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot) + (cfDates, defRates, ppyRates,rateVector,remainTerms) + + let lastProjTxn = last txns + let extraTxns = [ CF.emptyTsRow d lastProjTxn | d <- recoveryDates ] - (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery (txns++extraTxns) amr) - begBal = CF.buildBegBal futureTxns + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery (txns++extraTxns) amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) -- project current mortgage(with delinq) projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current) @@ -483,20 +485,21 @@ instance Ast.Asset Mortgage where ,_ ,_) mRates = - Right $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay, Nothing) futureTxns) ,historyM) - where + let + (recoveryRate, recoveryLag) = Ast.getRecoveryLagAndRate amr lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:getPaymentDates m (recoveryLag+defaultLag) + (_,defaultLag,defaultPct) = Ast.getDefaultDelinqAssump amd cfDates cfDatesLength = length cfDates + recoveryLag + defaultLag - - rateVector = A.projRates cr or mRates cfDates - - (ppyRates,delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) = Ast.buildAssumptionPpyDelinqDefRecRate (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams) - - txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector - (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot) - (replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0) - (futureTxns,historyM)= CF.cutoffTrs asOfDay txns - begBal = CF.buildBegBal futureTxns + in + do + rateVector <- A.projRates cr or mRates cfDates + (ppyRates,delinqRates,(_,_),_,_) <- Ast.buildAssumptionPpyDelinqDefRecRate (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams) + let txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector + (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot) + (replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay txns + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay, Nothing) futureTxns) ,historyM) -- project defaulted Mortgage projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn (Defaulted (Just defaultedDate)) ) @@ -527,88 +530,94 @@ instance Ast.Asset Mortgage where asOfDay mars@(A.MortgageAssump amd amp amr ams,_,_) mRates = - Right $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) - where + let ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm passInitPeriod = (ot - rt) >= initPeriod firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) - + (recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate amr lastPayDate:cfDates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recoveryLag + 1) $ sd:getPaymentDates m recoveryLag - cfDatesLength = length cfDates -- `debug` (" cf dates >>" ++ show (last_pay_date:cf_dates )) rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates rateVector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve) - - (ppyRates,defRates,recoveryRate,recoveryLag) = buildAssumptionPpyDefRecRate (lastPayDate:cfDates) (A.MortgageAssump amd amp amr ams) - remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt] - dc = getDayCount or scheduleBalToday = calcScheduleBalaceToday m mRates asOfDay - (txns,_) = projectMortgageFlow (scheduleBalToday, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot) (cfDates, defRates, ppyRates,rateVector,remainTerms) - (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) - begBal = CF.buildBegBal futureTxns - + dc = getDayCount or + in + do + (ppyRates,defRates,recoveryRate,recoveryLag) <- buildAssumptionPpyDefRecRate (lastPayDate:cfDates) (A.MortgageAssump amd amp amr ams) + let remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt] + let (txns,_) = projectMortgageFlow (scheduleBalToday, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot) (cfDates, defRates, ppyRates,rateVector,remainTerms) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) + -- project current AdjMortgage with delinq projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current) asOfDay - mars@(A.MortgageAssump amd amp amr ams,_,_) - mRates = - Right $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) - where - ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm - passInitPeriod = (ot - rt) >= initPeriod - firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) - lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:getPaymentDates m recoveryLag - cfDatesLength = length cfDates - rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates - rateVector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve) - - (ppyRates, delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) = Ast.buildAssumptionPpyDelinqDefRecRate (lastPayDate:cfDates) (A.MortgageAssump amd amp amr ams) - - txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector - (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot) - (replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0) - (futureTxns,historyM)= CF.cutoffTrs asOfDay txns - begBal = CF.buildBegBal futureTxns + mars@(A.MortgageDeqAssump amd amp amr ams,_,_) + mRates + = let + ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm + passInitPeriod = (ot - rt) >= initPeriod + firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) + (recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate amr + -- Ast.getDefaultDelinqAssump amd + lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:getPaymentDates m recoveryLag + (_,defaultLag,defaultPct) = Ast.getDefaultDelinqAssump amd cfDates + cfDatesLength = length cfDates + rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates + rateVector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve) + in + do + (ppyRates, delinqRates,(_,_),_,_) <- Ast.buildAssumptionPpyDelinqDefRecRate (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams) + let txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector + (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot) + (replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay txns + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) -- schedule mortgage flow without delinq projCashflow (ScheduleMortgageFlow begDate flows dp) asOfDay - assumps@(pAssump@(A.MortgageAssump _ _ _ ams ),dAssump,fAssump) _ - = Right $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff,asOfDay,Nothing) futureTxns) ,historyM) - where + assumps@(pAssump@(A.MortgageAssump _ _ mRa ams ),dAssump,fAssump) _ + = let begBal = CF.mflowBegBalance $ head flows - (ppyRates,defRates,recoveryRate,recoveryLag) = buildAssumptionPpyDefRecRate (begDate:cfDates) pAssump - curveDatesLength = recoveryLag + length flows - extraPeriods = recoveryLag endDate = CF.getDate (last flows) - extraDates = genSerialDates dp Exc endDate extraPeriods + (recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate mRa + curveDatesLength = recoveryLag + length flows + extraDates = genSerialDates dp Exc endDate recoveryLag cfDates = (CF.getDate <$> flows) ++ extraDates - txns = projectScheduleFlow [] 1.0 begBal flows defRates ppyRates - (replicate curveDatesLength 0.0) - (replicate curveDatesLength 0.0) - (recoveryLag,recoveryRate) - (futureTxns,historyM) = CF.cutoffTrs asOfDay txns - begBalAfterCutoff = CF.buildBegBal futureTxns - + in + do + (ppyRates,defRates,recoveryRate,recoveryLag) <- buildAssumptionPpyDefRecRate (begDate:cfDates) pAssump + let txns = projectScheduleFlow [] 1.0 begBal flows defRates ppyRates + (replicate curveDatesLength 0.0) + (replicate curveDatesLength 0.0) + (recoveryLag,recoveryRate) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns + let begBalAfterCutoff = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff,asOfDay,Nothing) futureTxns) ,historyM) -- schedule mortgage flow WITH delinq projCashflow (ScheduleMortgageFlow begDate flows dp) asOfDay assumps@(pAssump@(A.MortgageDeqAssump _ _ _ ams),dAssump,fAssump) mRates = - Right $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff, asOfDay,Nothing) futureTxns) ,historyM) - where + let begBal = CF.mflowBegBalance $ head flows -- `debug` ("beg date"++show beg_date) - (ppyRates, delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) = Ast.buildAssumptionPpyDelinqDefRecRate (begDate:getDates flows) pAssump - curveDatesLength = defaultLag + recoveryLag + length flows -- `debug` ("Length of rates"++show (length delinqRates)++">>"++show (length ppyRates)) - extraPeriods = defaultLag + recoveryLag -- `debug` ("lags "++show defaultLag++">>"++show recoveryLag) - endDate = CF.getDate (last flows) - extraDates = genSerialDates dp Exc endDate extraPeriods - extraFlows = [ CF.emptyTsRow d r | (d,r) <- zip extraDates (replicate extraPeriods (last flows)) ] - flowWithExtraDates = flows ++ extraFlows - cfDates = getDates flowWithExtraDates -- `debug` ("CF dates"++ show flowWithExtraDates) - txns = projectScheduleDelinqFlow ([],[]) 1.0 begBal flowWithExtraDates delinqRates ppyRates - (replicate curveDatesLength 0.0) (replicate curveDatesLength 0.0) - (replicate curveDatesLength 0.0) (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("Delinq rates"++ show delinqRates++">>ppy rates"++ show ppyRates) - (futureTxns,historyM) = CF.cutoffTrs asOfDay txns - begBalAfterCutoff = CF.buildBegBal futureTxns + in + do + (ppyRates, delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) <- Ast.buildAssumptionPpyDelinqDefRecRate (begDate:getDates flows) pAssump + let curveDatesLength = defaultLag + recoveryLag + length flows -- `debug` ("Length of rates"++show (length delinqRates)++">>"++show (length ppyRates)) + let extraPeriods = defaultLag + recoveryLag -- `debug` ("lags "++show defaultLag++">>"++show recoveryLag) + let endDate = CF.getDate (last flows) + let extraDates = genSerialDates dp Exc endDate extraPeriods + let extraFlows = [ CF.emptyTsRow d r | (d,r) <- zip extraDates (replicate extraPeriods (last flows)) ] + let flowWithExtraDates = flows ++ extraFlows + let cfDates = getDates flowWithExtraDates -- `debug` ("CF dates"++ show flowWithExtraDates) + let txns = projectScheduleDelinqFlow ([],[]) 1.0 begBal flowWithExtraDates delinqRates ppyRates + (replicate curveDatesLength 0.0) (replicate curveDatesLength 0.0) + (replicate curveDatesLength 0.0) (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("Delinq rates"++ show delinqRates++">>ppy rates"++ show ppyRates) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns + let begBalAfterCutoff = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff, asOfDay,Nothing) futureTxns) ,historyM) projCashflow a b c d = Left $ "Failed to match when proj mortgage with assumption >>" ++ show a ++ show b ++ show c ++ show d diff --git a/src/AssetClass/ProjectedCashFlow.hs b/src/AssetClass/ProjectedCashFlow.hs index e4bb5463..2bb31c08 100644 --- a/src/AssetClass/ProjectedCashFlow.hs +++ b/src/AssetClass/ProjectedCashFlow.hs @@ -71,57 +71,62 @@ projectScheduleFlow trs b_factor lastBal [] _ _ (r:rs) (l:ls) (recovery_lag,reco -projFixCfwithAssumption :: (CF.CashFlowFrame, DatePattern) -> Maybe A.AssetPerfAssumption -> Date -> CF.CashFlowFrame +projFixCfwithAssumption :: (CF.CashFlowFrame, DatePattern) -> Maybe A.AssetPerfAssumption -> Date -> Either String CF.CashFlowFrame projFixCfwithAssumption (cf@(CF.CashFlowFrame (begBal, begDate, accInt) flows), dp) - mPassump - asOfDay - = CF.CashFlowFrame (cb,asOfDay,Nothing) futureTxns - where + mPassump + asOfDay + = let curveDatesLength = recoveryLag + length flows endDate = CF.getDate (last flows) - (ppyRates,defRates,recoveryRate,recoveryLag) = case mPassump of - Just pAssump -> buildAssumptionPpyDefRecRate (begDate:cfDates) pAssump - Nothing -> (replicate curveDatesLength 0.0, replicate curveDatesLength 0.0, 0.0, 0) extraDates = genSerialDates dp Exc endDate recoveryLag + (recoveryRate,recoveryLag) = case mPassump of + Nothing -> (0,0) + (Just (A.MortgageAssump _ _ x _) )-> Ast.getRecoveryLagAndRate x + (Just (A.MortgageDeqAssump _ _ x _) )-> Ast.getRecoveryLagAndRate x cfDates = (CF.getDate <$> flows) ++ extraDates + in + do + (ppyRates,defRates,recoveryRate,recoveryLag) <- case mPassump of + Just pAssump -> buildAssumptionPpyDefRecRate (begDate:cfDates) pAssump + Nothing -> Right (replicate curveDatesLength 0.0, replicate curveDatesLength 0.0, 0.0, 0) - txns = projectScheduleFlow [] 1.0 begBal flows defRates ppyRates + let txns = projectScheduleFlow [] 1.0 begBal flows defRates ppyRates (replicate curveDatesLength 0.0) (replicate curveDatesLength 0.0) (recoveryLag,recoveryRate) -- `debug` (" begin bal"++ show begBal) - (futureTxns,historyM) = CF.cutoffTrs asOfDay txns + let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns - cb = (CF.mflowBegBalance . head) futureTxns + let cb = (CF.mflowBegBalance . head) futureTxns + return $ CF.CashFlowFrame (cb,asOfDay,Nothing) futureTxns -projIndexCashflows :: ([Date],[Balance],[Principal],Index,Spread) -> DatePattern -> Maybe A.AssetPerfAssumption -> Maybe [RateAssumption] -> CF.CashFlowFrame +projIndexCashflows :: ([Date],[Balance],[Principal],Index,Spread) -> DatePattern -> Maybe A.AssetPerfAssumption -> Maybe [RateAssumption] -> Either String CF.CashFlowFrame projIndexCashflows (ds,bals,principals,index,spd) dp mPassump (Just ras) = - let - mIndexToApply = A.getRateAssumption ras index - indexRates = A.lookupRate0 ras index <$> ds - - rates = (spd +) <$> indexRates - interestFlow = zipWith (flip mulBIR) rates bals - flowSize = length bals - scheduleCf = CF.CashFlowFrame (head bals, head ds, Nothing) $ - zipWith12 MortgageFlow - ds - bals - principals - interestFlow - (replicate flowSize 0 ) - (replicate flowSize 0 ) - (replicate flowSize 0 ) - (replicate flowSize 0 ) - rates - (replicate flowSize Nothing) - (replicate flowSize Nothing) - (replicate flowSize Nothing) - in + do + -- mIndexToApply = A.getRateAssumption ras index + indexRates <- sequenceA $ A.lookupRate0 ras index <$> ds + + let rates = (spd +) <$> indexRates + let interestFlow = zipWith (flip mulBIR) rates bals + let flowSize = length bals + let scheduleCf = CF.CashFlowFrame (head bals, head ds, Nothing) $ + zipWith12 MortgageFlow + ds + bals + principals + interestFlow + (replicate flowSize 0 ) + (replicate flowSize 0 ) + (replicate flowSize 0 ) + (replicate flowSize 0 ) + rates + (replicate flowSize Nothing) + (replicate flowSize Nothing) + (replicate flowSize Nothing) projFixCfwithAssumption (scheduleCf, dp) mPassump (head ds) -- ^ project cashflow with fix rate portion and floater rate portion -seperateCashflows :: ProjectedCashflow -> Maybe A.AssetPerfAssumption -> Maybe [RateAssumption] -> (CF.CashFlowFrame, [CF.CashFlowFrame]) +seperateCashflows :: ProjectedCashflow -> Maybe A.AssetPerfAssumption -> Maybe [RateAssumption] -> Either String (CF.CashFlowFrame, [CF.CashFlowFrame]) seperateCashflows (ProjectedFlowMixFloater pflow@(CF.CashFlowFrame (begBal, begDate, accuredInt) flows) dp (fixPct,fixRate) floaterList) mPassump mRates @@ -135,12 +140,7 @@ seperateCashflows (ProjectedFlowMixFloater pflow@(CF.CashFlowFrame (begBal, begD fixedPrincipalFlow = flip mulBR fixPct <$> CF.mflowPrincipal <$> flows fixedInterestFlow = flip mulBIR fixRate <$> fixedBals fixFlow = zipWith12 MortgageFlow ds fixedBals fixedPrincipalFlow fixedInterestFlow (replicate flowSize 0) (replicate flowSize 0) (replicate flowSize 0) (replicate flowSize 0) (replicate flowSize fixRate) (replicate flowSize Nothing) (replicate flowSize Nothing) (replicate flowSize Nothing) - fixedCashFlow = projFixCfwithAssumption ((CF.CashFlowFrame ( ((flip mulBR) fixPct) begBal - , begDate - , (flip mulBR) fixPct <$> accuredInt) - fixFlow) - , dp) mPassump begDate - -- float rate cashflow + -- float rate cashflow totalFloatBalFlow = zipWith (-) totalBals fixedBals floatPrincipalFlow = zipWith (-) (CF.mflowPrincipal <$> flows) fixedPrincipalFlow @@ -151,14 +151,20 @@ seperateCashflows (ProjectedFlowMixFloater pflow@(CF.CashFlowFrame (begBal, begD floatBalsBreakDown = (\r -> flip mulBR r <$> totalFloatBalFlow ) <$> rs floatPrincipalFlowBreakDown = (\r -> flip mulBR r <$> floatPrincipalFlow) <$> rs -- `debug` ("float bal breakdown"++ show floatBalsBreakDown) - floatedCashFlow = (\x -> projIndexCashflows x dp mPassump mRates) <$> zip5 - (replicate floaterSize ds) - floatBalsBreakDown - floatPrincipalFlowBreakDown - indexes - spds in - (fixedCashFlow, floatedCashFlow) -- `debug` ("float cf"++ show floatedCashFlow) + do + fixedCashFlow <- projFixCfwithAssumption ((CF.CashFlowFrame ( ((flip mulBR) fixPct) begBal + , begDate + , (flip mulBR) fixPct <$> accuredInt) + fixFlow) + , dp) mPassump begDate + floatedCashFlow <- sequenceA $ (\x -> projIndexCashflows x dp mPassump mRates) <$> zip5 + (replicate floaterSize ds) + floatBalsBreakDown + floatPrincipalFlowBreakDown + indexes + spds + return (fixedCashFlow, floatedCashFlow) -- `debug` ("float cf"++ show floatedCashFlow) @@ -179,19 +185,20 @@ instance Ast.Asset ProjectedCashflow where calcCashflow f@(ProjectedFlowFixed cf _) d _ = Right $ cf calcCashflow f@(ProjectedFlowMixFloater cf _ fxPortion floatPortion) d mRate - = let - (fixedCashFlow, floatedCashFlow) = seperateCashflows f Nothing mRate -- `debug` ("running fixed cashflow"++show fixedCashFlow) - in - Right $ foldl CF.combine fixedCashFlow floatedCashFlow + = do + (fixedCashFlow, floatedCashFlow) <- seperateCashflows f Nothing mRate -- `debug` ("running fixed cashflow"++show fixedCashFlow) + return $ foldl CF.combine fixedCashFlow floatedCashFlow -- projFixCfwithAssumption :: (CF.CashFlowFrame, DatePattern) -> A.AssetPerfAssumption -> Date -> CF.CashFlowFrame projCashflow f@(ProjectedFlowFixed cf dp) asOfDay (pAssump,_,_) mRates - = Right $ (projFixCfwithAssumption (cf, dp) (Just pAssump) asOfDay,Map.empty) + = + do + p <- projFixCfwithAssumption (cf, dp) (Just pAssump) asOfDay + return (p, Map.empty) projCashflow f asOfDay (pAssump, _, _) mRates - = let - (fixedCashFlow, floatedCashFlow) = seperateCashflows f (Just pAssump) mRates - in - Right $ (foldl CF.combine fixedCashFlow floatedCashFlow, Map.empty) + = do + (fixedCashFlow, floatedCashFlow) <- seperateCashflows f (Just pAssump) mRates + return $ (foldl CF.combine fixedCashFlow floatedCashFlow, Map.empty) --(fixedCashFlow, Map.empty) projCashflow a b c d = Left $ "Failed to match when proj projected flow with assumption >>" ++ show a ++ show b ++ show c ++ show d diff --git a/src/AssetClass/Receivable.hs b/src/AssetClass/Receivable.hs index e54b5238..3bb361c4 100644 --- a/src/AssetClass/Receivable.hs +++ b/src/AssetClass/Receivable.hs @@ -32,7 +32,6 @@ import Debug.Trace import Assumptions (AssetPerfAssumption(ReceivableAssump)) import GHC.Float.RealFracMethods (truncateFloatInteger) import Cashflow (extendTxns) -import Liability (backoutDueIntByYield) import qualified Asset as A debug = flip trace @@ -143,25 +142,26 @@ instance Asset Receivable where asOfDay massump@(A.ReceivableAssump amd amr ams, _ , _) mRates - = Right $ (CF.CashFlowFrame (ob,asOfDay,Nothing) futureTxns, historyM) - where - payDate = dd - feeDue = calcDueFactorFee r payDate - initTxn = CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing - - defaultRates = A.buildDefaultRates (sd:[dd]) amd - defaultAmt = mulBR ob (head defaultRates) - afterDefaultBal = ob - defaultAmt - afterDefaultFee = mulBR feeDue (1 - (head defaultRates)) - - feePaid = min afterDefaultBal afterDefaultFee - principal = max 0 $ afterDefaultBal - feePaid + = let + payDate = dd + feeDue = calcDueFactorFee r payDate + initTxn = CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing + in + do + defaultRates <- A.buildDefaultRates (sd:[dd]) amd + let defaultAmt = mulBR ob (head defaultRates) + let afterDefaultBal = ob - defaultAmt + let afterDefaultFee = mulBR feeDue (1 - (head defaultRates)) + + let feePaid = min afterDefaultBal afterDefaultFee + let principal = max 0 $ afterDefaultBal - feePaid - realizedLoss = case amr of - Nothing -> defaultAmt - Just _ -> 0 + let realizedLoss = case amr of + Nothing -> defaultAmt + Just _ -> 0 - txns = [initTxn, CF.ReceivableFlow payDate 0 0 principal feePaid defaultAmt 0 realizedLoss Nothing] - (futureTxns,historyM) = CF.cutoffTrs asOfDay $ txns++(buildRecoveryCfs payDate defaultAmt amr) -- `debug` ("recovery flow"++ show (buildRecoveryCfs payDate defaultAmt amr)) - + let txns = [initTxn, CF.ReceivableFlow payDate 0 0 principal feePaid defaultAmt 0 realizedLoss Nothing] + let (futureTxns,historyM) = CF.cutoffTrs asOfDay $ txns++(buildRecoveryCfs payDate defaultAmt amr) -- `debug` ("recovery flow"++ show (buildRecoveryCfs payDate defaultAmt amr)) + return $ (CF.CashFlowFrame (ob,asOfDay,Nothing) futureTxns, historyM) + projCashflow a b c d = Left $ "Failed to match when proj receivable with assumption >>" ++ show a ++ show b ++ show c ++ show d diff --git a/src/Assumptions.hs b/src/Assumptions.hs index df2c8981..508e59dc 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -14,9 +14,12 @@ module Assumptions (BondPricingInput(..) ,NonPerfAssumption(..),AssetPerf ,AssetDelinquencyAssumption(..) ,AssetDelinqPerfAssumption(..),AssetDefaultedPerfAssumption(..) - ,getCDR,calcResetDates,IssueBondEvent(..) + ,calcResetDates,IssueBondEvent(..) ,TagMatchRule(..),ObligorStrategy(..),RefiEvent(..),InspectType(..) - ,FieldMatchRule(..),CallOpt(..)) + ,FieldMatchRule(..),CallOpt(..) + ,_MortgageAssump,_MortgageDeqAssump,_LeaseAssump,_LoanAssump,_InstallmentAssump + ,_ReceivableAssump,_FixedAssetAssump + ) where import Call as C @@ -40,23 +43,25 @@ import GHC.Generics import AssetClass.AssetBase import Debug.Trace import InterestRate +import Control.Lens hiding (Index) + debug = flip trace type AssetPerf = (AssetPerfAssumption,AssetDelinqPerfAssumption,AssetDefaultedPerfAssumption) type StratPerfByIdx = ([Int],AssetPerf) -lookupAssumptionByIdx :: [StratPerfByIdx] -> Int -> AssetPerf +lookupAssumptionByIdx :: [StratPerfByIdx] -> Int -> Either String AssetPerf lookupAssumptionByIdx sbi i = case find (\(indxs,_) -> Set.member i (Set.fromList indxs) ) sbi of - Just (_, aps ) -> aps - Nothing -> error ("Can't find idx"++ show i ++"in starfication list"++ show sbi) + Just (_, aps ) -> Right aps + Nothing -> Left ("Lookup assumption by ID: Can't find idx"++ show i ++"in starfication list"++ show sbi) type ObligorTagStr = String -data TagMatchRule = TagEq -- ^ match exactly +data TagMatchRule = TagEq -- ^ match exactly | TagSubset | TagSuperset - | TagAny -- ^ match any tag hit + | TagAny -- ^ match any tag hit | TagNot TagMatchRule -- ^ Negative match deriving (Show, Generic, Read) @@ -66,15 +71,14 @@ data FieldMatchRule = FieldIn String [String] | FieldNot FieldMatchRule deriving (Show, Generic, Read) - data ObligorStrategy = ObligorById [String] AssetPerf | ObligorByTag [ObligorTagStr] TagMatchRule AssetPerf | ObligorByField [FieldMatchRule] AssetPerf | ObligorByDefault AssetPerf deriving (Show, Generic, Read) -data ApplyAssumptionType = PoolLevel AssetPerf -- ^ assumption apply to all assets in the pool - | ByIndex [StratPerfByIdx] -- ^ assumption which only apply to a set of assets in the pool +data ApplyAssumptionType = PoolLevel AssetPerf -- ^ assumption apply to all assets in the pool + | ByIndex [StratPerfByIdx] -- ^ assumption which only apply to a set of assets in the pool | ByName (Map.Map PoolId AssetPerf) -- ^ assumption for a named pool | ByObligor [ObligorStrategy] | ByPoolId (Map.Map PoolId ApplyAssumptionType) -- ^ assumption for a pool @@ -85,7 +89,7 @@ type RateFormula = DealStats type BalanceFormula = DealStats data IssueBondEvent = IssueBondEvent (Maybe Pre) BondName AccName Bond (Maybe BalanceFormula) (Maybe RateFormula) - | DummyIssueBondEvent + | FundingBondEvent (Maybe Pre) BondName AccName Balance deriving (Show, Generic, Read) data RefiEvent = RefiRate AccountName BondName InterestInfo @@ -108,7 +112,7 @@ data NonPerfAssumption = NonPerfAssumption { ,callWhen :: Maybe [CallOpt] -- ^ optional call options set, once any of these were satisfied, then clean up waterfall is triggered ,revolving :: Maybe RevolvingAssumption -- ^ optional revolving assumption with revoving assets ,interest :: Maybe [RateAssumption] -- ^ optional interest rates assumptions - ,inspectOn :: Maybe [InspectType] -- ^ optional tuple list to inspect variables during waterfall run + ,inspectOn :: Maybe [InspectType] -- ^ optional tuple list to inspect variables during waterfall run ,buildFinancialReport :: Maybe DatePattern -- ^ optional dates to build financial reports ,pricing :: Maybe BondPricingInput -- ^ optional bond pricing input( discount curve etc) ,fireTrigger :: Maybe [(Date,DealCycle,String)] -- ^ optional fire a trigger @@ -124,7 +128,7 @@ data AssumptionInput = Single ApplyAssumptionType NonPerfAssumption data AssetDefaultAssumption = DefaultConstant Rate -- ^ using constant default rate | DefaultCDR Rate -- ^ using annualized default rate | DefaultVec [Rate] -- ^ using default rate vector - | DefaultVecPadding [Rate] -- ^ using default rate vector + | DefaultVecPadding [Rate] -- ^ using default rate vector, but padding with last rate till end | DefaultByAmt (Balance,[Rate]) | DefaultAtEnd -- ^ default 100% at end | DefaultAtEndByRate Rate Rate -- ^ life time default rate and default rate at end @@ -181,36 +185,42 @@ data AssetPerfAssumption = MortgageAssump (Maybe AssetDefaultAssumption) (May | FixedAssetAssump Ts Ts -- util rate, price deriving (Show,Generic,Read) + data RevolvingAssumption = AvailableAssets RevolvingPool ApplyAssumptionType | AvailableAssetsBy (Map.Map String (RevolvingPool, ApplyAssumptionType)) deriving (Show,Generic) -data BondPricingInput = DiscountCurve Date Ts -- ^ PV curve used to discount bond cashflow and a PV date where cashflow discounted to +type HistoryCash = Ts +type CurrentHolding = Balance +type PricingDate = Date + +data BondPricingInput = DiscountCurve PricingDate Ts -- ^ PV curve used to discount bond cashflow and a PV date where cashflow discounted to | RunZSpread Ts (Map.Map BondName (Date,Rational)) -- ^ PV curve as well as bond trading price with a deal used to calc Z - spread - | OASInput Date BondName Balance [Spread] (Map.Map String Ts) -- ^ only works in multiple assumption request + -- | OASInput Date BondName Balance [Spread] (Map.Map String Ts) -- ^ only works in multiple assumption request + | DiscountRate PricingDate Rate + | IRRInput (Map.Map BondName (HistoryCash,CurrentHolding,Maybe (Dates, PricingMethod))) -- ^ IRR calculation for a list of bonds deriving (Show,Generic) -getCDR :: Maybe AssetDefaultAssumption -> Maybe Rate -getCDR (Just (DefaultCDR r)) = Just r -getCDR _ = Nothing getIndexFromRateAssumption :: RateAssumption -> Index getIndexFromRateAssumption (RateCurve idx _) = idx getIndexFromRateAssumption (RateFlat idx _) = idx -lookupRate :: [RateAssumption] -> Floater -> Date -> IRate +-- ^ lookup rate from rate assumption with index and spread +lookupRate :: [RateAssumption] -> Floater -> Date -> Either String IRate lookupRate rAssumps (index,spd) d = case find (\x -> getIndexFromRateAssumption x == index ) rAssumps of - Just (RateCurve _ ts) -> spd + fromRational (getValByDate ts Inc d) - Just (RateFlat _ r) -> r + spd - Nothing -> error $ "Failed to find Index " ++ show index + Just (RateCurve _ ts) -> Right $ spd + fromRational (getValByDate ts Inc d) + Just (RateFlat _ r) -> Right $ r + spd + Nothing -> Left $ "Failed to find Index " ++ show index ++ "in list "++ show rAssumps -lookupRate0 :: [RateAssumption] -> Index -> Date -> IRate +-- ^ lookup rate from rate assumption with index +lookupRate0 :: [RateAssumption] -> Index -> Date -> Either String IRate lookupRate0 rAssumps index d = case find (\x -> getIndexFromRateAssumption x == index ) rAssumps of - Just (RateCurve _ ts) -> fromRational (getValByDate ts Inc d) - Just (RateFlat _ r) -> r - Nothing -> error $ "Failed to find Index " ++ show index + Just (RateCurve _ ts) -> Right $ fromRational (getValByDate ts Inc d) + Just (RateFlat _ r) -> Right r + Nothing -> Left $ "Failed to find Index " ++ show index ++ " from Rate Assumption" ++ show rAssumps getRateAssumption :: [RateAssumption] -> Index -> Maybe RateAssumption @@ -222,29 +232,31 @@ getRateAssumption assumps idx assumps -- | project rates used by rate type ,with interest rate assumptions and observation dates -projRates :: IRate -> RateType -> Maybe [RateAssumption] -> [Date] -> [IRate] -projRates sr (Fix _ r) _ ds = replicate (length ds) sr +projRates :: IRate -> RateType -> Maybe [RateAssumption] -> [Date] -> Either String [IRate] +projRates sr (Fix _ r) _ ds = Right $ replicate (length ds) sr +projRates sr (Floater _ idx spd r dp rfloor rcap mr) Nothing ds = Left $ "Looking up rate error: No rate assumption found for index "++ show idx projRates sr (Floater _ idx spd r dp rfloor rcap mr) (Just assumps) ds = case getRateAssumption assumps idx of - Nothing -> error ("Failed to find index rate " ++ show idx ++ " from "++ show assumps) + Nothing -> Left ("Failed to find index rate " ++ show idx ++ " from "++ show assumps) Just _rateAssumption -> - let - resetDates = genSerialDatesTill2 NO_IE (head ds) dp (last ds) - ratesFromCurve = case _rateAssumption of - (RateCurve _ ts) -> (\x -> spd + (fromRational x) ) <$> (getValByDates ts Inc resetDates) - (RateFlat _ v) -> (spd +) <$> replicate (length resetDates) v - _ -> error ("Invalid rate type "++ show _rateAssumption) - ratesUsedByDates = getValByDates - (mkRateTs $ zip ((head ds):resetDates) (sr:ratesFromCurve)) - Inc - ds - in - case (rfloor,rcap) of - (Nothing, Nothing) -> fromRational <$> ratesUsedByDates - (Just fv, Just cv) -> capWith cv $ floorWith fv $ fromRational <$> ratesUsedByDates - (Just fv, Nothing) -> floorWith fv $ fromRational <$> ratesUsedByDates - (Nothing, Just cv) -> capWith cv $ fromRational <$> ratesUsedByDates -projRates _ rt rassump ds = error ("Invalid rate type: "++ show rt++" assump: "++ show rassump) + Right $ + let + resetDates = genSerialDatesTill2 NO_IE (head ds) dp (last ds) + ratesFromCurve = case _rateAssumption of + (RateCurve _ ts) -> (\x -> spd + (fromRational x) ) <$> (getValByDates ts Inc resetDates) + (RateFlat _ v) -> (spd +) <$> replicate (length resetDates) v + _ -> error ("Invalid rate type "++ show _rateAssumption) + ratesUsedByDates = getValByDates + (mkRateTs $ zip ((head ds):resetDates) (sr:ratesFromCurve)) + Inc + ds + in + case (rfloor,rcap) of + (Nothing, Nothing) -> fromRational <$> ratesUsedByDates + (Just fv, Just cv) -> capWith cv $ floorWith fv $ fromRational <$> ratesUsedByDates + (Just fv, Nothing) -> floorWith fv $ fromRational <$> ratesUsedByDates + (Nothing, Just cv) -> capWith cv $ fromRational <$> ratesUsedByDates +projRates _ rt rassump ds = Left ("Invalid rate type: "++ show rt++" assump: "++ show rassump) -- ^ Given a list of rates, calcualte whether rates was reset @@ -267,3 +279,5 @@ $(concat <$> traverse (deriveJSON defaultOptions) [''FieldMatchRule,''TagMatchRu , ''AssetDefaultedPerfAssumption, ''AssetDelinqPerfAssumption, ''NonPerfAssumption, ''AssetDefaultAssumption , ''AssetPrepayAssumption, ''RecoveryAssumption, ''ExtraStress , ''LeaseAssetGapAssump, ''LeaseAssetRentAssump, ''RevolvingAssumption, ''AssetDelinquencyAssumption,''InspectType]) + +makePrisms ''AssetPerfAssumption \ No newline at end of file diff --git a/src/Cashflow.hs b/src/Cashflow.hs index c51aa668..fa563608 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -109,11 +109,11 @@ instance Semigroup TsRow where CashFlow d1 a1 <> (CashFlow d2 a2) = CashFlow (max d1 d2) (a1 + a2) BondFlow d1 b1 p1 i1 <> (BondFlow d2 b2 p2 i2) = BondFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1 <> MortgageFlow d2 b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2 st2 - = MortgageFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) (liftA2 (+) mbn1 mbn2) (liftA2 (+) pn1 pn2) (sumStats st1 st2) + = MortgageFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (liftA2 (+) mbn1 mbn2) (liftA2 (+) pn1 pn2) (sumStats st1 st2) MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 st1 <> MortgageDelinqFlow d2 b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2 st2 - = MortgageDelinqFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (delinq1 + delinq2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) (liftA2 (+) mbn1 mbn2) (liftA2 (+) pn1 pn2) (sumStats st1 st2) + = MortgageDelinqFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (delinq1 + delinq2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (liftA2 (+) mbn1 mbn2) (liftA2 (+) pn1 pn2) (sumStats st1 st2) LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1 <> LoanFlow d2 b2 p2 i2 prep2 def2 rec2 los2 rat2 st2 - = LoanFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) (sumStats st1 st2) + = LoanFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (sumStats st1 st2) LeaseFlow d1 b1 r1 <> LeaseFlow d2 b2 r2 = LeaseFlow (max d1 d2) (b1 + b2) (r1 + r2) FixedFlow d1 b1 ndep1 dep1 c1 a1 <> FixedFlow d2 b2 ndep2 dep2 c2 a2 @@ -224,10 +224,6 @@ sizeCashFlowFrame (CashFlowFrame _ ts) = length ts getDatesCashFlowFrame :: CashFlowFrame -> [Date] getDatesCashFlowFrame (CashFlowFrame _ ts) = getDates ts --- getDateRangeCashFlowFrame :: CashFlowFrame -> (Date,Date) --TODO what if it is empty ? --- getDateRangeCashFlowFrame (CashFlowFrame _ [tr]) = (getDate tr, getDate tr) --- getDateRangeCashFlowFrame (CashFlowFrame _ trs) = (getDate (head trs), getDate (last trs)) - getBegBalCashFlowFrame :: CashFlowFrame -> Balance getBegBalCashFlowFrame (CashFlowFrame _ []) = 0 getBegBalCashFlowFrame (CashFlowFrame _ (cf:cfs)) = mflowBegBalance cf @@ -267,7 +263,7 @@ addTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@(Mort p = (+) <$> pn1 <*> pn2 st = sumStats st1 st2 in - MortgageFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p st + MortgageFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st addTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@(MortgageDelinqFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2 st2) = let bn = (+) <$> mbn1 <*> mbn2 @@ -275,10 +271,10 @@ addTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 delinq = (+) delinq1 delinq2 st = sumStats st1 st2 in - MortgageDelinqFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p st + MortgageDelinqFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st addTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1) tr@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 st2) - = LoanFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) (sumStats st1 st2) + = LoanFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (sumStats st1 st2) addTs (LeaseFlow d1 b1 r1) tr@(LeaseFlow d2 b2 r2) = LeaseFlow d1 (b1 - mflowAmortAmount tr) (r1 + r2) @@ -300,7 +296,7 @@ combineTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 delinq = (+) delinq1 delinq2 st = sumStats st1 st2 in - MortgageDelinqFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p st + MortgageDelinqFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st combineTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2 st2) = let @@ -308,10 +304,10 @@ combineTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@( p = (+) <$> pn1 <*> pn2 st = sumStats st1 st2 in - MortgageFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p st + MortgageFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st combineTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1) tr@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 st2) - = LoanFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) (sumStats st1 st2) + = LoanFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (sumStats st1 st2) combineTs (LeaseFlow d1 b1 r1) tr@(LeaseFlow d2 b2 r2) = LeaseFlow d1 (b1 + b2) (r1 + r2) @@ -373,7 +369,7 @@ addTsCF m1@(MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1) m2@ p = (+) <$> pn1 <*> pn2 st = maxStats st1 st2 in - MortgageFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p st + MortgageFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st addTsCF (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 st1) (MortgageDelinqFlow d2 b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2 st2) = let bn = min <$> mbn1 <*> mbn2 @@ -381,9 +377,9 @@ addTsCF (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 p delinq = (+) delinq1 delinq2 st = maxStats st1 st2 in - MortgageDelinqFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p st + MortgageDelinqFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st addTsCF (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1) (LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 st2) - = LoanFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) (maxStats st1 st2) + = LoanFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (maxStats st1 st2) addTsCF (LeaseFlow d1 b1 r1) (LeaseFlow d2 b2 r2) = LeaseFlow d1 (min b1 b2) (r1 + r2) addTsCF (FixedFlow d1 b1 dep1 cd1 u1 c1) (FixedFlow d2 b2 dep2 cd2 u2 c2) = FixedFlow d1 (min b1 b2) (dep1 + dep2) (cd1 + cd2) u2 (c1 + c2) @@ -873,8 +869,8 @@ aggTs (r:rs) (tr:trs) patchBalance :: (Balance,Maybe CumulativeStat) -> [TsRow] -> [TsRow] -> [TsRow] patchBalance (bal,stat) [] [] = [] patchBalance (bal,mStat) r [] = case mStat of - Just stat -> patchCumulative stat [] $ reverse r - Nothing -> patchCumulative (0,0,0,0,0,0) [] $ reverse r + Just stat -> patchCumulative stat [] $ reverse r + Nothing -> patchCumulative (0,0,0,0,0,0) [] $ reverse r patchBalance (bal,stat) r (tr:trs) = let amortAmt = mflowAmortAmount tr @@ -935,6 +931,7 @@ mergePoolCf2 cf1@(CashFlowFrame st1@(bBal1,bDate1,a1) txns1) cf2@(CashFlowFrame in over cashflowTxn (++ txnCombined) resultCf1 + mergeCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame mergeCf cf (CashFlowFrame _ []) = cf mergeCf (CashFlowFrame _ []) cf = cf diff --git a/src/CreditEnhancement.hs b/src/CreditEnhancement.hs index fee08b62..22dbb9b3 100644 --- a/src/CreditEnhancement.hs +++ b/src/CreditEnhancement.hs @@ -7,7 +7,7 @@ module CreditEnhancement (LiqFacility(..),LiqSupportType(..),buildLiqResetAction,buildLiqRateResetAction ,LiquidityProviderName,draw,repay,accrueLiqProvider ,LiqDrawType(..),LiqRepayType(..),LiqCreditCalc(..) - ,consolStmt + ,consolStmt,CreditDefaultSwap(..),CDSType(..) ) where @@ -133,17 +133,12 @@ draw amt d liq@LiqFacility{ liqBalance = liqBal ,liqDueInt = dueInt ,liqDuePremium = duePremium} | isJust mCredit && (fromMaybe 0 mCredit) <= 0 = - liq { liqStmt = appendStmt - mStmt $ - SupportTxn d mCredit liqBal dueInt duePremium 0 LiquidationDraw - } + liq { liqStmt = appendStmt (SupportTxn d mCredit liqBal dueInt duePremium 0 LiquidationDraw) mStmt } | otherwise = liq { liqBalance = newBal,liqCredit = newCredit,liqStmt = newStmt} where - newCredit = (\x -> x - amt) <$> mCredit -- `debug` ("date "++ show d ++" insert orgin credit : "++show mCredit) - newBal = liqBal + amt -- `debug` (show d ++"New bal"++ show liqBal ++ " "++ show amt++ "new credit: "++ show newCredit) - newStmt = appendStmt - mStmt $ - SupportTxn d newCredit newBal dueInt duePremium (negate amt) LiquidationDraw + newCredit = (\x -> x - amt) <$> mCredit + newBal = liqBal + amt + newStmt = appendStmt (SupportTxn d newCredit newBal dueInt duePremium (negate amt) LiquidationDraw) mStmt repay :: Amount -> Date -> LiqRepayType -> LiqFacility -> LiqFacility @@ -154,11 +149,8 @@ repay amt d pt liq@LiqFacility{liqBalance = liqBal ,liqDueInt = liqDueInt ,liqDuePremium = liqDuePremium ,liqType = lt} - = liq {liqBalance = newBal - ,liqCredit = newCredit - ,liqDueInt = newIntDue - ,liqDuePremium = newDuePremium - ,liqStmt = newStmt} + = liq {liqBalance = newBal ,liqCredit = newCredit ,liqDueInt = newIntDue + ,liqDuePremium = newDuePremium ,liqStmt = newStmt} where (newBal, newIntDue, newDuePremium) = case pt of @@ -176,10 +168,7 @@ repay amt d pt liq@LiqFacility{liqBalance = liqBal (Just IncludeBoth, LiqPremium) -> (+ amt) <$> mCredit _ -> mCredit - newStmt = appendStmt mStmt $ - SupportTxn d newCredit newBal newIntDue newDuePremium amt $ - LiquidationRepay (show pt) -- `debug` ("date "++ show d ++" insert rpt type"++show pt) - + newStmt = appendStmt (SupportTxn d newCredit newBal newIntDue newDuePremium amt (LiquidationRepay (show pt))) mStmt -- | accure fee and interest of a liquidity provider and update credit available accrueLiqProvider :: Date -> LiqFacility -> LiqFacility @@ -226,17 +215,7 @@ accrueLiqProvider d liq@(LiqFacility _ _ curBal mCredit mCreditType mRateType mP Just IncludeDuePremium -> (\x -> x - accureFee) <$> mCredit Just IncludeBoth -> (\x -> x - accureInt - accureFee) <$> mCredit - newStmt = appendStmt mStmt $ SupportTxn d - newCredit - curBal - newDueInt - newDueFee - 0 - (LiquidationSupportInt accureInt accureFee) - - --- makeLensesFor [("liqStmt","liqStmtLens")] ''LiqFacility - + newStmt = appendStmt (SupportTxn d newCredit curBal newDueInt newDueFee 0 (LiquidationSupportInt accureInt accureFee)) mStmt instance QueryByComment LiqFacility where @@ -276,6 +255,40 @@ instance IR.UseRate LiqFacility where getIndex liq = head <$> IR.getIndexes liq +data CDSType = CoverageAttachDetach Balance Balance + | CoverageAttach Balance + | CoverageDetach Balance + | AllCoverage + deriving (Show, Generic, Eq, Ord) + +data CreditDefaultSwap = CDS { + cdsName :: String + ,cdsType :: CDSType + + ,cdsInsure :: DealStats -- ^ the coverage + ,cdsCollectDue :: Balance -- ^ the amount to collect from CDS + + ,cdsPremiumRefBalance :: DealStats -- ^ how notional balance is calculated + ,cdsPremiumNotional :: Balance -- ^ the balance to calculate premium + + ,cdsPremiumRate :: IRate -- ^ the rate to calculate premium + ,cdsRateType :: Maybe IR.RateType -- ^ interest rate type + + ,cdsPremiumDue :: Balance -- ^ the due premium to payout from SPV + + ,cdsLastCalcDate :: Maybe Date -- ^ last calculate date on net cash + + ,cdsSettleDate :: Maybe Date -- ^ last setttle date on net cash + ,cdsNetCash :: Balance -- ^ the net cash to settle ,negative means SPV pay to CDS, positive means CDS pay to SPV + + ,cdsStart :: Date + ,cdsEnds :: Maybe Date + ,cdsStmt :: Maybe Statement +} deriving (Show, Generic, Eq, Ord) + + + + $(deriveJSON defaultOptions ''LiqRepayType) $(deriveJSON defaultOptions ''LiqDrawType) $(deriveJSON defaultOptions ''LiqSupportType) diff --git a/src/DateUtil.hs b/src/DateUtil.hs index e531c97b..2ff9e93f 100644 --- a/src/DateUtil.hs +++ b/src/DateUtil.hs @@ -33,7 +33,7 @@ yearCountFraction dc sd ed (sDaysTillYearEnd % (daysOfYear syear)) + (eDaysAfterYearBeg % (daysOfYear eyear)) + (pred _diffYears) -- `debug` ("<>"++show sDaysTillYearEnd++"<>"++show(daysOfYear syear) ++"<>"++show (daysOfYear eyear)++"<>"++ show eyear) - DC_ACT_365F -> _diffDays % 365 -- `debug` ("DIFF Days"++show(_diffDays)) + DC_ACT_365F -> _diffDays % 365 DC_ACT_360 -> _diffDays % 360 @@ -186,6 +186,7 @@ genSerialDates dp ct sd num CustomDate ds -> ds EveryNMonth d n -> d:[ T.addGregorianDurationClip (T.CalendarDiffDays ((toInteger _n)*(toInteger n)) 0) d | _n <- [1..num] ] + SingletonDate d -> [d] where quarterEnds = [(3,31),(6,30),(9,30),(12,31)] @@ -219,6 +220,7 @@ genSerialDatesTill sd ptn ed CustomDate ds -> 2 + toInteger (length ds) EveryNMonth _d _n -> div cdM (toInteger _n) Weekday _d -> cdM * 4 + SingletonDate _d -> if _d <= ed then 1 else 0 _ -> error $ "failed to match" ++ show ptn -- DayOfWeek Int -> -- T.DayOfWeek diff --git a/src/Deal.hs b/src/Deal.hs index cf16d14c..bcb6b47d 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -65,6 +65,7 @@ import Data.Aeson.Types import GHC.Generics import Control.Monad import Control.Monad.Loops (allM,anyM) +import Control.Applicative (liftA2) import Debug.Trace import Cashflow (buildBegTsRow) @@ -86,69 +87,75 @@ setBondNewRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bon setBondNewRate t d ras b@(L.Bond _ _ L.OriginalInfo{ L.originDate = od} ii _ bal currentRate _ dueInt _ Nothing _ _ _) = setBondNewRate t d ras b {L.bndDueIntDate = Just od} +-- ^ Floater rate +setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Floater br idx _spd rset dc mf mc) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = Right $ (L.accrueInt d b){ L.bndRate = applyFloatRate ii d ras } --- ^ Floater rate+step up(once) -setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Floater br idx _spd rset dc mf mc) (Just (L.PassDateSpread resetDay spd)) bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) - | resetDay == d = Right $ b { L.bndRate = currentRate + spd, L.bndDueInt = dueInt + accrueInt - , L.bndDueIntDate = Just d - , L.bndInterestInfo = L.Floater br idx (_spd+spd) rset dc mf mc} - | otherwise = Right $ b { L.bndRate = applyFloatRate ii d ras - , L.bndDueInt = dueInt + accrueInt, L.bndDueIntDate = Just d} - where - (Just dc) = getDayCountFromInfo ii - accrueInt = calcInt (bal + dueInt) dueIntDate d currentRate dc - --- ^ Floater rate+step up(ladder) TODO ,it's not ladder -setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Floater br idx _spd rset dc mf mc) (Just (L.PassDateSpread resetDay spd)) bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) - | resetDay == d = Right $ b { L.bndRate = currentRate + spd, L.bndDueInt = dueInt + accrueInt - , L.bndDueIntDate = Just d - , L.bndInterestInfo = L.Floater br idx (_spd+spd) rset dc mf mc} - | otherwise = Right $ b { L.bndRate = applyFloatRate ii d ras - , L.bndDueInt = dueInt + accrueInt, L.bndDueIntDate = Just d} - where - (Just dc) = getDayCountFromInfo ii - accrueInt = calcInt (bal + dueInt) dueIntDate d currentRate dc - --- ^ Fix rate+step up(once) -setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Fix {}) (Just (L.PassDateSpread resetDay spd)) bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) - | resetDay == d = Right $ b { L.bndRate = currentRate + spd, L.bndDueInt = dueInt + accrueInt, L.bndDueIntDate = Just d} - | otherwise = Right b - where - (Just dc) = getDayCountFromInfo ii - accrueInt = calcInt (bal + dueInt) dueIntDate d currentRate dc - --- ^ Fix rate+step up(ladder) -setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Fix {}) (Just (L.PassDateLadderSpread _ spd _)) bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) - = Right $ b { L.bndRate = currentRate + spd, L.bndDueInt = dueInt + accrueInt, L.bndDueIntDate = Just d} - where - (Just dc) = getDayCountFromInfo ii - accrueInt = calcInt (bal + dueInt) dueIntDate d currentRate dc +-- ^ Fix rate, do nothing +setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Fix {}) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = Right b -- ^ Ref rate setBondNewRate t d ras b@(L.Bond _ _ _ (L.RefRate sr ds factor _) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) = do + let b' = L.accrueInt d b rate <- queryCompound t d (patchDateToStats d ds) - let accrueInt = calcInt (bal + dueInt) dueIntDate d (fromRational rate) DC_ACT_365F - return b {L.bndRate = fromRational (rate * toRational factor) - ,L.bndDueInt = dueInt + accrueInt, L.bndDueIntDate = Just d} - --- ^ floater bond -setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Floater br idx _spd rset dc mf mc) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) - = Right $ b { L.bndRate = applyFloatRate ii d ras - , L.bndDueInt = dueInt + accrueInt, L.bndDueIntDate = Just d} - where - (Just dc) = getDayCountFromInfo ii - accrueInt = calcInt (bal + dueInt) dueIntDate d currentRate dc + return b' {L.bndRate = fromRational (rate * toRational factor) } +-- ^ do nothing for bond with interest by yield +setBondNewRate t d ras b@(L.Bond _ _ _ (L.InterestByYield {}) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = Right b + +-- ^ cap & floor & IoI +setBondNewRate t d ras b@(L.Bond _ _ _ ii _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = Right $ (L.accrueInt d b) { L.bndRate = applyFloatRate ii d ras} + +-- ^ bond group setBondNewRate t d ras bg@(L.BondGroup bMap) = do m <- mapM (setBondNewRate t d ras) bMap return $ L.BondGroup m +-- ^ apply all rates for multi-int bond +setBondNewRate t d ras b@(L.MultiIntBond bn _ _ iis _ bal currentRates _ dueInts dueIoIs _ _ _ _) + = let + newRates = applyFloatRate <$> iis <*> pure d <*> pure ras + b' = L.accrueInt d b -- `debug` ("accrue due to new rate "++ bn) + in + Right $ b' { L.bndRates = newRates } + +setBondNewRate t d ras b = Left $ "set bond new rate: "++ show d ++"Failed to set bond rate: "++show b++"from rate assumption" ++ show ras + + +setBondStepUpRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond +setBondStepUpRate t d ras b@(L.Bond _ _ _ ii (Just sp) _ _ _ _ _ _ _ _ _) + = Right $ + let + newII = L.stepUpInterestInfo sp ii + newRate = applyFloatRate ii d ras + in + (L.accrueInt d b) { L.bndInterestInfo = newII, L.bndRate = newRate } -updateSrtRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> HE.SRT -> HE.SRT +setBondStepUpRate t d ras b@(L.MultiIntBond bn _ _ iis (Just sps) _ _ _ _ _ _ _ _ _) + = Right $ + let + newIIs = zipWith L.stepUpInterestInfo sps iis + newRates = (\x -> applyFloatRate x d ras) <$> newIIs + in + (L.accrueInt d b) { L.bndInterestInfos = newIIs, L.bndRates = newRates } -- `debug` (show d ++ ">> accure due to step up rate "++ bn) + +setBondStepUpRate t d ras bg@(L.BondGroup bMap) + = do + m <- mapM (setBondStepUpRate t d ras) bMap + return $ L.BondGroup m + + + +updateSrtRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> HE.SRT -> Either String HE.SRT updateSrtRate t d ras srt@HE.SRT{HE.srtPremiumType = rt} - = srt { HE.srtPremiumRate = applyFloatRate2 rt d ras } + = do + r <- applyFloatRate2 rt d ras + return srt { HE.srtPremiumRate = r } accrueSrt :: Ast.Asset a => TestDeal a -> Date -> HE.SRT -> Either String HE.SRT @@ -166,7 +173,7 @@ accrueSrt t d srt@HE.SRT{ HE.srtDuePremium = duePrem, HE.srtRefBalance = bal, HE updateLiqProviderRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> CE.LiqFacility -> CE.LiqFacility updateLiqProviderRate t d ras liq@CE.LiqFacility{CE.liqRateType = mRt, CE.liqPremiumRateType = mPrt - , CE.liqRate = mr, CE.liqPremiumRate = mPr } + , CE.liqRate = mr, CE.liqPremiumRate = mPr } = let newMr = evalFloaterRate d ras <$> mRt newMpr = evalFloaterRate d ras <$> mPrt @@ -176,6 +183,22 @@ updateLiqProviderRate t d ras liq@CE.LiqFacility{CE.liqRateType = mRt, CE.liqPre updateLiqProviderRate t d ras liq = liq +-- CDS + +-- ^ accure CDS +-- accrueCDS :: Ast.Asset a => TestDeal a -> Date -> CE.CreditDefaultSwap -> Either String CE.CreditDefaultSwap +-- accrueCDS t d cds@CDS{} = Right cds + +-- accrueCDS + + + +-- ^ settle CDS +-- settleCDS :: Ast.Asset a => TestDeal a -> Date -> CE.CDS -> Either String (CE.CDS + + + + evalFloaterRate :: Date -> [RateAssumption] -> IR.RateType -> IRate evalFloaterRate _ _ (IR.Fix _ r) = r evalFloaterRate d ras (IR.Floater _ idx spd _r _ mFloor mCap mRounding) @@ -209,63 +232,89 @@ applyFloatRate (L.Floater _ idx spd p dc mf mc) d ras applyFloatRate (L.CapRate ii _rate) d ras = min _rate (applyFloatRate ii d ras) applyFloatRate (L.FloorRate ii _rate) d ras = max _rate (applyFloatRate ii d ras) applyFloatRate (L.Fix r _ ) d ras = r +applyFloatRate (L.WithIoI ii _) d ras = applyFloatRate ii d ras -applyFloatRate2 :: IR.RateType -> Date -> [RateAssumption] -> IRate -applyFloatRate2 (IR.Fix _ r) _ _ = r +applyFloatRate2 :: IR.RateType -> Date -> [RateAssumption] -> Either String IRate +applyFloatRate2 (IR.Fix _ r) _ _ = Right r applyFloatRate2 (IR.Floater _ idx spd _r _ mFloor mCap mRounding) d ras = let - rateAtDate = AP.lookupRate0 ras idx d flooring (Just f) v = max f v flooring Nothing v = v capping (Just f) v = min f v capping Nothing v = v in - flooring mFloor $ capping mCap $ rateAtDate + spd + do + rateAtDate <- AP.lookupRate0 ras idx d + return $ flooring mFloor $ capping mCap $ rateAtDate + spd -updateRateSwapRate :: [RateAssumption] -> Date -> HE.RateSwap -> HE.RateSwap -updateRateSwapRate rAssumps d rs@HE.RateSwap{ HE.rsType = rt } - = rs {HE.rsPayingRate = pRate, HE.rsReceivingRate = rRate } - where - (pRate,rRate) = case rt of - HE.FloatingToFloating flter1 flter2 -> (getRate flter1,getRate flter2) - HE.FloatingToFixed flter r -> (getRate flter, r) - HE.FixedToFloating r flter -> (r , getRate flter) +updateRateSwapRate :: Ast.Asset a => TestDeal a -> Maybe [RateAssumption] -> Date -> HE.RateSwap -> Either String HE.RateSwap +updateRateSwapRate t Nothing _ _ = Left "Failed to update rate swap: No rate input assumption" +updateRateSwapRate t (Just rAssumps) d rs@HE.RateSwap{ HE.rsType = rt } + = let getRate x = AP.lookupRate rAssumps x d + in + do + (pRate,rRate) <- case rt of + HE.FloatingToFloating flter1 flter2 -> + do + r1 <- getRate flter1 + r2 <- getRate flter2 + return (r1, r2) + HE.FloatingToFixed flter r -> + do + _r <- getRate flter + return (_r, r) + HE.FixedToFloating r flter -> + do + _r <- getRate flter + return (r, _r) + HE.FormulaToFloating ds flter -> + do + _r <- queryCompound t d (patchDateToStats d ds) + r <- getRate flter + return (fromRational _r, r) + HE.FloatingToFormula flter ds -> + do + r <- getRate flter + _r <- queryCompound t d (patchDateToStats d ds) + return (r, fromRational _r) + return rs {HE.rsPayingRate = pRate, HE.rsReceivingRate = rRate } updateRateSwapBal :: Ast.Asset a => TestDeal a -> Date -> HE.RateSwap -> Either String HE.RateSwap updateRateSwapBal t d rs@HE.RateSwap{ HE.rsNotional = base } = case base of - HE.Fixed _ -> Right rs - HE.Schedule ts -> Right $ rs { HE.rsRefBalance = fromRational (getValByDate ts Inc d) } - HE.Base ds -> - do - v <- queryCompound t d (patchDateToStats d ds) - return rs { HE.rsRefBalance = fromRational v} -- `debug` ("query Result"++ show (patchDateToStats d ds) ) + HE.Fixed _ -> Right rs + HE.Schedule ts -> Right $ rs { HE.rsRefBalance = fromRational (getValByDate ts Inc d) } + HE.Base ds -> + do + v <- queryCompound t d (patchDateToStats d ds) + return rs { HE.rsRefBalance = fromRational v} -- `debug` ("query Result"++ show (patchDateToStats d ds) ) -- ^ accure rate cap accrueRC :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> RateCap -> Either String RateCap accrueRC t d rs rc@RateCap{rcNetCash = amt, rcStrikeRate = strike,rcIndex = index - ,rcStartDate = sd, rcEndDate = ed, rcNotional = notional - ,rcLastStlDate = mlsd - ,rcStmt = mstmt} + ,rcStartDate = sd, rcEndDate = ed, rcNotional = notional + ,rcLastStlDate = mlsd + ,rcStmt = mstmt} | d > ed || d < sd = Right rc - | otherwise = let - r = lookupRate0 rs index d - in - do - balance <- case notional of - Fixed bal -> Right . toRational $ bal - Base ds -> queryCompound t d (patchDateToStats d ds) - Schedule ts -> Right $ getValByDate ts Inc d + | otherwise = do + r <- lookupRate0 rs index d + balance <- case notional of + Fixed bal -> Right . toRational $ bal + Base ds -> queryCompound t d (patchDateToStats d ds) + Schedule ts -> Right $ getValByDate ts Inc d + + let accRate = max 0 $ r - fromRational (getValByDate strike Inc d) -- `debug` ("Rate from curve"++show (getValByDate strike Inc d)) + let addAmt = case mlsd of + Nothing -> calcInt (fromRational balance) sd d accRate DC_ACT_365F + Just lstD -> calcInt (fromRational balance) lstD d accRate DC_ACT_365F + + let newAmt = amt + addAmt -- `debug` ("Accrue AMT"++ show addAmt) + let newStmt = appendStmt (IrsTxn d newAmt addAmt 0 0 0 SwapAccrue) mstmt + return $ rc { rcLastStlDate = Just d ,rcNetCash = newAmt, rcStmt = newStmt } + - let accRate = max 0 $ r - fromRational (getValByDate strike Inc d) -- `debug` ("Rate from curve"++show (getValByDate strike Inc d)) - let addAmt = case mlsd of - Nothing -> calcInt (fromRational balance) sd d accRate DC_ACT_365F - Just lstD -> calcInt (fromRational balance) lstD d accRate DC_ACT_365F - let newAmt = amt + addAmt -- `debug` ("Accrue AMT"++ show addAmt) - let newStmt = appendStmt mstmt $ IrsTxn d newAmt addAmt 0 0 0 SwapAccrue - return $ rc { rcLastStlDate = Just d ,rcNetCash = newAmt, rcStmt = newStmt } -- ^ test if a clean up call should be fired testCall :: Ast.Asset a => TestDeal a -> Date -> C.CallOption -> Either String Bool @@ -304,7 +353,8 @@ runEffects (t@TestDeal{accounts = accMap, fees = feeMap ,status=st, bonds = bond let newFeeMap = Map.fromList (zip fns newFeeList) <> feeMap return (t {fees = newFeeMap}, rc, actions, logs) ChangeReserveBalance accName rAmt -> - Right (t {accounts = Map.adjust (A.updateReserveBalance rAmt) accName accMap }, rc, actions, logs) + Right (t {accounts = Map.adjust (set A.accTypeLens (Just rAmt)) accName accMap } + , rc, actions, logs) TriggerEffects efs -> foldM (`runEffects` d) (t, rc, actions, logs) efs @@ -312,48 +362,6 @@ runEffects (t@TestDeal{accounts = accMap, fees = feeMap ,status=st, bonds = bond (newT, newRc, newLogs) <- foldM (performActionWrap d) (t, rc, []) wActions return (newT, newRc, actions, logs++newLogs) - CloseDeal (offset0,pDp) (offset1,bDp) (pm,accName,mIssuanceBal) mCollectRules - -> let - closingDate = d - (WarehousingDates _ _ _ endDate) = dates t - Warehousing nextSt = st - -- issue bonds - newBonds = Map.map (L.setBondOrigDate closingDate) bondMap - firstPayDate = T.addDays (toInteger offset0) closingDate - firstCollectDate = T.addDays (toInteger offset1) closingDate - distributionDays = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE firstPayDate bDp endDate] - poolCollectionDays = [ PoolCollection _d "" | _d <- genSerialDatesTill2 IE firstCollectDate pDp endDate] - newActions = (DealClosed closingDate):(sortBy sortActionOnDate (distributionDays++poolCollectionDays)) - --- TODO for floater rate bond ,need to update rate in the bond - in - do - draftBondBals <- queryCompound t d CurrentBondBalance - totalIssuanceBalance <- case mIssuanceBal of - Nothing -> Right draftBondBals - Just fml -> queryCompound t d fml - let scaleFactor = toRational $ totalIssuanceBalance / draftBondBals - let scaledBndMap = Map.map (L.scaleBond scaleFactor) newBonds - let accAfterIssue = Map.adjust (A.deposit (fromRational totalIssuanceBalance) d (IssuanceProceeds "ALL")) accName accMap - - let assetVal = case pt of - MultiPool pMap -> sum $ Map.map (\p -> P.calcLiquidationAmount pm p closingDate) pMap - assetBal <- queryCompound t d (FutureCurrentPoolBalance Nothing) - let accAfterBought = Map.adjust (A.draw assetVal d (PurchaseAsset "ALL" (fromRational assetBal))) accName accMap - - -- reset pool flow flow - let dealPoolFlowMap = Map.map (maybe 0 ((CF.mflowBalance . head) . (view CF.cashflowTxn))) - $ view dealCashflow t - let newPt = patchIssuanceBalance st dealPoolFlowMap pt - ---- reset pool stats - let newPt2 = case newPt of - MultiPool pm -> MultiPool $ Map.map (over (P.poolFutureCf2 . CF.cashflowTxn) (CF.patchCumulative (0,0,0,0,0,0) [])) pm - x -> x - -- build actions dates - return (t {status = fromMaybe Amortizing nextSt, bonds = scaledBndMap, accounts=accAfterBought, pool = newPt2 - ,collects = fromMaybe collRules mCollectRules} - , rc - , cutBy Inc Past d actions ++ newActions - , logs) --TODO add actions to close deal DoNothing -> Right (t, rc, actions, []) _ -> Left $ "Date:"++ show d++" Failed to match trigger effects: "++show te @@ -383,6 +391,25 @@ changeDealStatus:: Ast.Asset a => (Date,String)-> DealStatus -> TestDeal a -> (M changeDealStatus _ _ t@TestDeal{status=Ended} = (Nothing, t) changeDealStatus (d,why) newSt t@TestDeal{status=oldSt} = (Just (DealStatusChangeTo d oldSt newSt why), t {status=newSt}) + +-- runWaterfall :: Ast.Asset a => (TestDeal a ,Date, Runcontext a ,[ResultComponent]) -> String -> Either String (TestDeal a, RunContext a,[ResultComponent]) +-- runWaterfall (t,d, runContext,logs) waterfallKey = +-- let +-- -- attach waterfall log +-- +-- -- accure interest for all bonds +-- -- accure fees +-- -- accure any hedge & liq support +-- +-- -- run waterfall +-- (newDeal, newRc, newLogs) = foldl' (performActionWrap d) (t,runContext,[]) (Map.findWithDefault [] W.DefaultDistribution (waterfall t)) +-- in +-- Right (newDeal, newRc, logs++newLogs) + +-- let eopActionsLog = [ RunningWaterfall d W.EndOfPoolCollection | Map.member W.EndOfPoolCollection waterfallM ] -- `debug` ("new logs from trigger 1"++ show newLogs0) +-- let waterfallToExe = Map.findWithDefault [] W.EndOfPoolCollection (waterfall t) -- `debug` ("new logs from trigger 1"++ show newLogs0) + + run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.CashFlowFrame -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre]) -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType))-> [ResultComponent] -> Either String (TestDeal a,[ResultComponent]) run t@TestDeal{status=Ended} pCfM ads _ _ _ log = Right (prepareDeal t,log++[EndRun Nothing "By Status:Ended"]) @@ -424,14 +451,15 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= run dRunWithTrigger1 (runPoolFlow rc3) (Just ads3) rates calls rAssump (newLogs0++newLogs++ eopActionsLog ++newLogs1) -- `debug` ("PoolCollection: Pt 05>> "++ show d++">> context flow>> "++show (runPoolFlow rc3)) else run t poolFlowMap (Just ads) rates calls rAssump log -- `debug` ("PoolCollection: hit zero pool length"++ show d++"pool"++ (show poolFlowMap)++"collected cf"++ show pt) - - RunWaterfall d _ -> + + -- Default waterfall execution action from payFreq from deal dates + RunWaterfall d "" -> let runContext = RunContext poolFlowMap rAssump rates waterfallKey = if Map.member (W.DistributionDay dStatus) waterfallM then - W.DistributionDay dStatus - else - W.DefaultDistribution + W.DistributionDay dStatus + else + W.DefaultDistribution waterfallToExe = Map.findWithDefault [] waterfallKey waterfallM callTest = fst $ fromMaybe ([]::[Pre],[]::[Pre]) calls @@ -456,6 +484,22 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= (dRunWithTrigger1, rc3, ads2, newLogs2) <- runTriggers (dAfterWaterfall,rc2,ads1) d EndDistributionWF -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall >>"++ show (runPoolFlow rc2)++" collected >>"++ show (pool dAfterWaterfall)) run dRunWithTrigger1 (runPoolFlow rc3) (Just ads2) rates calls rAssump (newLogsWaterfall++newLogs2++logsBeforeDist++[RunningWaterfall d waterfallKey]) -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall 3>>"++ show (pool dRunWithTrigger1)++" status>>"++ show (status dRunWithTrigger1)) + -- Custom waterfall execution action from deal dates + RunWaterfall d wName -> + let + runContext = RunContext poolFlowMap rAssump rates + waterfallKey = W.CustomWaterfall wName + waterfallToExe = Map.findWithDefault [] waterfallKey waterfallM + in + do + -- (dRunWithTrigger0, rc1, ads1, newLogs0) <- runTriggers (t, runContext, ads) d BeginDistributionWF -- `debug` ("In RunWaterfall Date"++show d++"before run trigger>> collected"++ show (pool t)) + let logsBeforeDist =[ WarningMsg (" No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) + | Map.notMember waterfallKey waterfallM ] + (dAfterWaterfall, rc2, newLogsWaterfall) <- foldM (performActionWrap d) (t,runContext,log) waterfallToExe -- `debug` (show d ++ " running action"++ show waterfallToExe) + -- (dRunWithTrigger1, rc3, ads2, newLogs2) <- runTriggers (dAfterWaterfall,rc2,ads1) d EndDistributionWF -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall >>"++ show (runPoolFlow rc2)++" collected >>"++ show (pool dAfterWaterfall)) + run dAfterWaterfall (runPoolFlow rc2) (Just ads) rates calls rAssump (newLogsWaterfall++logsBeforeDist++[RunningWaterfall d waterfallKey]) -- `debug` ("size of logs"++ show (length newLogsWaterfall)++ ">>"++ show d++ show (length logsBeforeDist)) + + EarnAccInt d accName -> let newAcc = Map.adjust (A.depositInt d) accName accMap @@ -504,18 +548,49 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= ChangeDealStatusTo d s -> run (t{status=s}) poolFlowMap (Just ads) rates calls rAssump log - ResetIRSwapRate d sn -> + CalcIRSwap d sn -> case rateSwap t of - Nothing -> Left $ " No rate swap found for "++ sn + Nothing -> Left $ " No rate swaps modeled when looking for "++ sn Just rSwap -> - let - _rates = fromMaybe [] rates - newRateSwap_rate = Map.adjust (updateRateSwapRate _rates d) sn rSwap - in - do - newRateSwap_bal <- adjustM (updateRateSwapBal t d) sn newRateSwap_rate - let newRateSwap_acc = Map.adjust (HE.accrueIRS d) sn $ newRateSwap_bal - run (t{rateSwap = Just newRateSwap_acc}) poolFlowMap (Just ads) rates calls rAssump log + do + newRateSwap_rate <- adjustM (updateRateSwapRate t rates d) sn rSwap + newRateSwap_bal <- adjustM (updateRateSwapBal t d) sn newRateSwap_rate + let newRateSwap_acc = Map.adjust (HE.accrueIRS d) sn $ newRateSwap_bal + run (t{rateSwap = Just newRateSwap_acc}) poolFlowMap (Just ads) rates calls rAssump log + + SettleIRSwap d sn -> + case rateSwap t of + Nothing -> Left $ " No rate swaps modeled when looking for "++ sn + Just rSwap -> + do + acc <- case HE.rsSettleDates (rSwap Map.! sn) of + Nothing -> Left $ "No settle date found for "++ sn + Just (_, _accName) -> Right $ accMap Map.! _accName + let accBal = A.accBalance acc + let rs = rSwap Map.! sn + let settleAmt = HE.rsNetCash rs + let accName = A.accName acc + case (settleAmt <0, accBal < abs settleAmt) of + (True, True) -> + let + newAcc = Map.adjust (A.draw accBal d (SwapOutSettle sn)) accName accMap + newRsMap = Just $ Map.adjust (HE.payoutIRS d accBal) sn rSwap + in + run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump + $ log ++ [WarningMsg $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn] + -- Left $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn + (True, False) -> + let + newAcc = Map.adjust (A.draw (abs settleAmt) d (SwapOutSettle sn)) accName accMap + newRsMap = Just $ Map.adjust (HE.payoutIRS d settleAmt) sn rSwap + in + run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log + (False, _) -> + let + newAcc = Map.adjust (A.deposit settleAmt d (SwapInSettle sn)) accName accMap + newRsMap = Just $ Map.adjust (HE.receiveIRS d) sn rSwap + in + run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log AccrueCapRate d cn -> case rateCap t of @@ -533,26 +608,33 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= newlog <- inspectListVars t d dss run t poolFlowMap (Just ads) rates calls rAssump $ log++newlog -- `debug` ("Add log"++show newlog) - ResetBondRate d bn -> + ResetBondRate d bn -> let rateList = fromMaybe [] rates bnd = bndMap Map.! bn in do - newBnd <- setBondNewRate t d rateList bnd + newBnd <- setBondNewRate t d rateList bnd run t{bonds = Map.fromList [(bn,newBnd)] <> bndMap} poolFlowMap (Just ads) rates calls rAssump log - ResetAccRate d accName -> + StepUpBondRate d bn -> let - newAccMap = Map.adjust + bnd = bndMap Map.! bn -- `debug` ("StepUpBondRate--------------"++ show bn) + in + do + -- newBnd <- setBondStepUpRate t d bnd `debug` ("StepUpBondRate"++ show d++ show bn) + newBndMap <- adjustM (setBondStepUpRate t d (fromMaybe [] rates)) bn bndMap + run t{bonds = newBndMap } poolFlowMap (Just ads) rates calls rAssump log + + -- TODO When reset rate, need to accrue interest + ResetAccRate d accName -> + do + newAccMap <- adjustM (\a@(A.Account _ _ (Just (A.InvestmentAccount idx spd dp dp1 lastDay _)) _ _) - -> let - newRate = AP.lookupRate (fromMaybe [] rates) (idx,spd) d - newAccInt = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate) - in - a { A.accInterest = newAccInt}) + -> do + newRate <- AP.lookupRate (fromMaybe [] rates) (idx,spd) d + return a { A.accInterest = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)}) accName accMap - in run t{accounts = newAccMap} poolFlowMap (Just ads) rates calls rAssump log BuildReport sd ed -> @@ -621,6 +703,32 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= bondPricingResult run t {bonds = depositBondFlow, status = Ended } poolFlowMap (Just []) rates calls rAssump $ log++[EndRun (Just d) "MakeWhole call"] + FundBond d Nothing bName accName fundAmt -> + let + newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap + in + do + newBnd <- calcDueInt t d Nothing Nothing $ bndMap Map.! bName + let bndFunded = L.fundWith d fundAmt newBnd + run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap} + poolFlowMap (Just ads) rates calls rAssump log + + FundBond d (Just p) bName accName fundAmt -> + let + newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap + in + do + flag <- testPre d t p + case flag of + False -> run t poolFlowMap (Just ads) rates calls rAssump (log ++ [WarningMsg ("Failed to fund bond"++ bName++ ":" ++show p)]) + True -> + do + newBnd <- calcDueInt t d Nothing Nothing $ bndMap Map.! bName + let bndFunded = L.fundWith d fundAmt newBnd + run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap} + poolFlowMap (Just ads) rates calls rAssump log + + IssueBond d Nothing bGroupName accName bnd mBal mRate -> run t poolFlowMap (Just ((IssueBond d (Just (Always True)) bGroupName accName bnd mBal mRate):ads)) rates calls rAssump log @@ -665,18 +773,20 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= -- settle accrued interest -- TODO rebuild bond rate reset actions lstDate = getDate (last ads) + isResetActionEvent (ResetBondRate _ bName ) = False + isResetActionEvent _ = True + filteredAds = filter isResetActionEvent ads + newRate = L.getBeginRate iInfo in do nBnd <- calcDueInt t d Nothing Nothing $ bndMap Map.! bName - let isResetActionEvent (ResetBondRate _ bName) = False - let isResetActionEvent _ = True - let filteredAds = filter isResetActionEvent ads - let newRate = L.getBeginRate iInfo - let dueIntToPay = L.totalDueInt nBnd + let dueIntToPay = L.getTotalDueInt nBnd let ((shortfall,drawAmt),newAcc) = A.tryDraw dueIntToPay d (PayInt [bName]) (accMap Map.! accName) let newBnd = set L.bndIntLens iInfo $ L.payInt d drawAmt nBnd let resetDates = L.buildRateResetDates newBnd d lstDate - let bResetActions = [ ResetBondRate d bName | d <- resetDates ] + -- let bResetActions = [ ResetBondRate d bName 0 | d <- resetDates ] + -- TODO tobe fix + let bResetActions = [] let newAccMap = Map.insert accName newAcc accMap let newBndMap = Map.insert bName (newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d ,L.bndLastIntPay = Just d}) bndMap @@ -715,19 +825,16 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= run t empty Nothing Nothing Nothing Nothing log - = - do + = do (t, ads, pcf, unStressPcf) <- getInits t Nothing Nothing run t pcf (Just ads) Nothing Nothing Nothing log -- `debug` ("Init Done >>Last Action#"++show (length ads)++"F/L"++show (head ads)++show (last ads)) - run t empty _ _ _ _ log = Right (prepareDeal t,log) -- `debug` ("End with pool CF is []") -- reserved for future used -data ExpectReturn = DealStatus - | DealPoolFlow +data ExpectReturn = DealPoolFlow | DealPoolFlowPricing -- ^ default option, return pricing and bond/pool/account/fee etc cashflow | DealTxns | ExecutionSummary @@ -735,7 +842,7 @@ data ExpectReturn = DealStatus priceBonds :: TestDeal a -> AP.BondPricingInput -> Map.Map String L.PriceResult priceBonds t (AP.DiscountCurve d dc) = Map.map (L.priceBond d dc) (viewBondsInMap t) -priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bond_prices) +priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bondPrices) = Map.mapWithKey (\bn (pd,price)-> L.ZSpread $ L.calcZspread @@ -746,10 +853,32 @@ priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bond_prices) ,toRational (rateToday pd - toRational (L.bndRate (bndMap Map.!bn)))) (bndMap Map.! bn) curve) - bond_prices + bondPrices where rateToday = getValByDate curve Inc +-- priceBonds t@TestDeal {bonds = bndMap} (AP.IRRInput inputList) +-- = let +-- bondHistoryFlow = [] +-- futureCashFlow = [] +-- in + +-- priceBondIrr :: BondName -> (HistoryCash,CurrentHolding,Maybe (Dates, PricingMethod)) -> Map.Map BondName L.Bond -> L.PriceResult +-- priceBondIrr bName (historyCashflow,position,mSell) m = +-- let +-- b = m Map.! bName +-- bBegBal = L.bndBalance b +-- bPct = position / bBegBal +-- bProjFlow = (\s -> (getDate s, mulBR (getTxnAmt s) bPct)) <$> getTxns $ L.bndStmt b +-- bCashFlow = bProjFlow ++ historyCashflow +-- bLastCf Nothing = [] +-- bLastCf (Just (ds,ByRate r)) = [] +-- bLastCf (Just (ds,ByCurve ts)) = [] +-- bLastCf (Just (ds,ByBalanceFactor r)) = [] +-- bLastCf (Just (ds,ByDm idx spd)) = [] +-- in +-- + -- ^ split call option assumption , -- lefts are for waterfall payment days @@ -796,19 +925,15 @@ runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts = do (newT, ads, pcf, unStressPcf) <- getInits t perfAssumps (Just nonPerfAssumps) (finalDeal, logs) <- run (removePoolCf newT) - pcf - (Just ads) - mInterest - (readCallOptions <$> opts) - mRevolvingCtx - [] + pcf + (Just ads) + mInterest + (readCallOptions <$> opts) + mRevolvingCtx + [] let poolFlowUsed = Map.map (fromMaybe (CF.CashFlowFrame (0,toDate "19000101",Nothing) [])) (getAllCollectedFrame finalDeal Nothing) let poolFlowUsedNoEmpty = Map.map (over CF.cashflowTxn CF.dropTailEmptyTxns) poolFlowUsed - -- bond pricing if any - let bndPricing = case mPricing of - Nothing -> Nothing - Just _bpi -> Just (priceBonds finalDeal _bpi) - + let bndPricing = (priceBonds finalDeal) <$> mPricing return (finalDeal, Just poolFlowUsedNoEmpty, Just (getRunResult finalDeal ++ V.validateRun finalDeal ++logs), bndPricing) -- `debug` ("Run Deal end with") where (runFlag, valLogs) = V.validateReq t nonPerfAssumps @@ -822,12 +947,13 @@ runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts -- run() is a recusive function loop over all actions till deal end conditions are met -- | get bond principal and interest shortfalls from a deal +-- TODO , what if bonds has funded during life time ? whatś the correct bond beg balance to be used ? getRunResult :: Ast.Asset a => TestDeal a -> [ResultComponent] getRunResult t = os_bn_i ++ os_bn_b -- `debug` ("Done with get result") where bs = viewDealAllBonds t - os_bn_b = [ BondOutstanding (L.bndName _b) (L.bndBalance _b) (getBondBegBal t (L.bndName _b)) | _b <- bs ] -- `debug` ("B"++ show bs) - os_bn_i = [ BondOutstandingInt (L.bndName _b) (L.bndDueInt _b) (getBondBegBal t (L.bndName _b)) | _b <- bs ] -- `debug` ("C"++ show bs) + os_bn_b = [ BondOutstanding (L.bndName _b) (L.getCurBalance _b) (getBondBegBal t (L.bndName _b)) | _b <- bs ] -- `debug` ("B"++ show bs) + os_bn_i = [ BondOutstandingInt (L.bndName _b) (L.getTotalDueInt _b) (getBondBegBal t (L.bndName _b)) | _b <- bs ] -- `debug` ("C"++ show bs) prepareDeal :: Ast.Asset a => TestDeal a -> TestDeal a prepareDeal t@TestDeal {bonds = bndMap, liqProvider = mLiqProvider} @@ -888,24 +1014,19 @@ removePoolCf t@TestDeal{pool=pt} = t {pool = newPt} -populateDealDates :: DateDesp -> DealStatus -> (Date,Date,Date,[ActionOnDate],[ActionOnDate],Date) -populateDealDates (WarehousingDates begDate rampingPoolDp rampingBondDp statedDate) - (Warehousing _) - = (begDate,begDate, getDate (head ba),pa,ba,statedDate) - where - pa = [ PoolCollection _d "" | _d <- genSerialDatesTill2 IE begDate rampingPoolDp statedDate ] - ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE begDate rampingBondDp statedDate ] - +populateDealDates :: DateDesp -> DealStatus -> Either String (Date,Date,Date,[ActionOnDate],[ActionOnDate],Date,[ActionOnDate]) populateDealDates (CustomDates cutoff pa closing ba) _ - = (cutoff + = Right $ + (cutoff ,closing ,getDate (head ba) ,pa ,ba - ,getDate (max (last pa) (last ba))) + ,getDate (max (last pa) (last ba)) + ,[]) populateDealDates (PatternInterval _m) _ - = (cutoff,closing,nextPay,pa,ba,max ed1 ed2) + = Right $ (cutoff,closing,nextPay,pa,ba,max ed1 ed2, []) where (cutoff,dp1,ed1) = _m Map.! CutoffDate (nextPay,dp2,ed2) = _m Map.! FirstPayDate @@ -914,26 +1035,78 @@ populateDealDates (PatternInterval _m) _ ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill nextPay dp2 ed2 ] populateDealDates (PreClosingDates cutoff closing mRevolving end (firstCollect,poolDp) (firstPay,bondDp)) _ - = (cutoff,closing,firstPay,pa,ba,end) + = Right $ (cutoff,closing,firstPay,pa,ba,end, []) where pa = [ PoolCollection _d "" | _d <- genSerialDatesTill2 IE firstCollect poolDp end ] ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE firstPay bondDp end ] populateDealDates (CurrentDates (lastCollect,lastPay) mRevolving end (nextCollect,poolDp) (nextPay,bondDp)) _ - = (lastCollect, lastPay,head futurePayDates, pa, ba, end) + = Right $ (lastCollect, lastPay,head futurePayDates, pa, ba, end, []) where futurePayDates = genSerialDatesTill2 IE nextPay bondDp end ba = [ RunWaterfall _d "" | _d <- futurePayDates] futureCollectDates = genSerialDatesTill2 IE nextCollect poolDp end pa = [ PoolCollection _d "" | _d <- futureCollectDates] +populateDealDates (GenericDates m) + (PreClosing _) + = let + requiredFields = (CutoffDate, ClosingDate, FirstPayDate, StatedMaturityDate + , DistributionDates, CollectionDates) + vals = lookupTuple6 requiredFields m + + isCustomWaterfallKey (CustomExeDates _) _ = True + isCustomWaterfallKey _ _ = False + custWaterfall = Map.toList $ Map.filterWithKey isCustomWaterfallKey m + in + case vals of + (Just (SingletonDate coffDate), Just (SingletonDate closingDate), Just (SingletonDate fPayDate) + , Just (SingletonDate statedDate), Just bondDp, Just poolDp) + -> let + pa = [ PoolCollection _d "" | _d <- genSerialDatesTill2 IE closingDate poolDp statedDate ] + ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE fPayDate bondDp statedDate ] + cu = [ RunWaterfall _d custName | (CustomExeDates custName, custDp) <- custWaterfall + , _d <- genSerialDatesTill2 EE closingDate custDp statedDate ] + in + Right (coffDate, closingDate, fPayDate, pa, ba, statedDate, cu) -- `debug` ("custom action"++ show cu) + _ + -> Left "Missing required dates in GenericDates in deal status PreClosing" + +populateDealDates (GenericDates m) _ + = let + requiredFields = (LastCollectDate, LastPayDate, NextPayDate, StatedMaturityDate + , DistributionDates, CollectionDates) + vals = lookupTuple6 requiredFields m + + isCustomWaterfallKey (CustomExeDates _) _ = True + isCustomWaterfallKey _ _ = False + custWaterfall = Map.toList $ Map.filterWithKey isCustomWaterfallKey m + in + case vals of + (Just (SingletonDate lastCollect), Just (SingletonDate lastPayDate), Just (SingletonDate nextPayDate) + , Just (SingletonDate statedDate), Just bondDp, Just poolDp) + -> let + pa = [ PoolCollection _d "" | _d <- genSerialDatesTill2 EE lastCollect poolDp statedDate ] + ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE nextPayDate bondDp statedDate ] + cu = [ RunWaterfall _d custName | (CustomExeDates custName, custDp) <- custWaterfall + , _d <- genSerialDatesTill2 EE lastCollect custDp statedDate ] + in + Right (lastCollect, lastPayDate, nextPayDate, pa, ba, statedDate, cu) -- `debug` ("custom action"++ show cu) + _ + -> Left "Missing required dates in GenericDates in deal status PreClosing" + + + + +-- populateDealDates (GenericDates m) (Running _) +-- = Right $ (epocDate, epocDate, epocDate, [], [], epocDate, []) + -- | run a pool of assets ,use asOfDate of Pool to cutoff cashflow yields from assets with assumptions supplied runPool :: Ast.Asset a => P.Pool a -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)] -- schedule cashflow just ignores the interest rate assumption -runPool (P.Pool [] (Just cf) _ asof _ _ ) Nothing _ - = Right $ [(cf, Map.empty)] +runPool (P.Pool [] (Just cf) _ asof _ _ ) Nothing _ = Right $ [(cf, Map.empty)] -- schedule cashflow with stress assumption runPool (P.Pool [] (Just (CF.CashFlowFrame _ txn)) _ asof _ (Just dp)) (Just (AP.PoolLevel assumps)) mRates = sequenceA [ Ast.projCashflow (ACM.ScheduleMortgageFlow asof txn dp) asof assumps mRates ] -- `debug` ("PROJ in schedule flow") @@ -954,9 +1127,10 @@ runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRate runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = let numAssets = length as - _assumps = map (AP.lookupAssumptionByIdx idxAssumps) [0..(pred numAssets)] -- `debug` ("Num assets"++ show numAssets) in - sequenceA $ zipWith (\x a -> Ast.projCashflow x asof a mRates) as _assumps + do + _assumps <- sequenceA $ map (AP.lookupAssumptionByIdx idxAssumps) [0..(pred numAssets)] -- `debug` ("Num assets"++ show numAssets) + sequenceA $ zipWith (\x a -> Ast.projCashflow x asof a mRates) as _assumps ---- By Obligor runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = let @@ -1038,7 +1212,7 @@ runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) -- safe net to catch other cases -runPool _a _b _c = error $ "Failed to match" ++ show _a ++ show _b ++ show _c +runPool _a _b _c = Left $ "Failed to match" ++ show _a ++ show _b ++ show _c -- ^ patch issuance balance for PreClosing Deal @@ -1143,131 +1317,147 @@ runPoolType (ResecDeal dm) mAssumps mNonPerfAssump getInits :: Ast.Asset a => TestDeal a -> Maybe AP.ApplyAssumptionType -> Maybe AP.NonPerfAssumption -> Either String (TestDeal a,[ActionOnDate], Map.Map PoolId CF.CashFlowFrame, Map.Map PoolId CF.CashFlowFrame) getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap} mAssumps mNonPerfAssump = - let - (startDate,closingDate,firstPayDate,pActionDates,bActionDates,endDate) = populateDealDates (dates t) status - - intEarnDates = A.buildEarnIntAction (Map.elems (accounts t)) endDate [] - - intAccRateResetDates = (A.buildRateResetDates endDate) <$> (Map.elems (accounts t)) + do + (startDate,closingDate,firstPayDate,pActionDates,bActionDates,endDate,custWdates) <- populateDealDates (dates t) status - iAccIntDates = [ EarnAccInt _d accName | (accName,accIntDates) <- intEarnDates - , _d <- accIntDates ] - iAccRateResetDates = concat [ [ResetAccRate _d accName | _d <- _ds] | rst@(Just (accName, _ds)) <- intAccRateResetDates, isJust rst ] + let intEarnDates = A.buildEarnIntAction (Map.elems (accounts t)) endDate [] + let intAccRateResetDates = (A.buildRateResetDates endDate) <$> (Map.elems (accounts t)) + let iAccIntDates = [ EarnAccInt _d accName | (accName,accIntDates) <- intEarnDates , _d <- accIntDates ] + let iAccRateResetDates = concat [ [ResetAccRate _d accName | _d <- _ds] | rst@(Just (accName, _ds)) <- intAccRateResetDates, isJust rst ] - --fee accrue dates - _feeAccrueDates = F.buildFeeAccrueAction (Map.elems feeMap) endDate [] - feeAccrueDates = [ AccrueFee _d _feeName | (_feeName,feeAccureDates) <- _feeAccrueDates - , _d <- feeAccureDates ] + --fee accrue dates + let _feeAccrueDates = F.buildFeeAccrueAction (Map.elems feeMap) endDate [] + let feeAccrueDates = [ AccrueFee _d _feeName | (_feeName,feeAccureDates) <- _feeAccrueDates , _d <- feeAccureDates ] --liquidation facility - liqResetDates = case liqProvider t of - Nothing -> [] - Just mLiqProvider -> - let - _liqResetDates = CE.buildLiqResetAction (Map.elems mLiqProvider) endDate [] - _liqRateResetDates = CE.buildLiqRateResetAction (Map.elems mLiqProvider) endDate [] - in - [ ResetLiqProvider _d _liqName |(_liqName,__liqResetDates) <- _liqResetDates - , _d <- __liqResetDates ] - ++ - [ ResetLiqProviderRate _d _liqName |(_liqName,__liqResetDates) <- _liqRateResetDates - , _d <- __liqResetDates ] + let liqResetDates = case liqProvider t of + Nothing -> [] + Just mLiqProvider -> + let + _liqResetDates = CE.buildLiqResetAction (Map.elems mLiqProvider) endDate [] + _liqRateResetDates = CE.buildLiqRateResetAction (Map.elems mLiqProvider) endDate [] + in + [ ResetLiqProvider _d _liqName |(_liqName,__liqResetDates) <- _liqResetDates , _d <- __liqResetDates ] + ++ + [ ResetLiqProviderRate _d _liqName |(_liqName,__liqResetDates) <- _liqRateResetDates , _d <- __liqResetDates ] --inspect dates - expandInspect (AP.InspectPt dp ds) = [ InspectDS _d [ds] | _d <- genSerialDatesTill2 II startDate dp endDate ] - expandInspect (AP.InspectRpt dp dss) = [ InspectDS _d dss | _d <- genSerialDatesTill2 II startDate dp endDate ] - inspectDates = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.inspectOn = Just inspectList } -> concat $ expandInspect <$> inspectList - _ -> [] + let expandInspect (AP.InspectPt dp ds) = [ InspectDS _d [ds] | _d <- genSerialDatesTill2 II startDate dp endDate ] + let expandInspect (AP.InspectRpt dp dss) = [ InspectDS _d dss | _d <- genSerialDatesTill2 II startDate dp endDate ] + + let inspectDates = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.inspectOn = Just inspectList } -> concat $ expandInspect <$> inspectList + _ -> [] - financialRptDates = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.buildFinancialReport= Just dp } - -> let - _ds = genSerialDatesTill2 II startDate dp endDate - in - [ BuildReport _sd _ed | (_sd,_ed) <- zip _ds (tail _ds) ] -- `debug` ("ds"++ show _ds) - _ -> [] -- `debug` ("emtpy rpt dates") - - irSwapRateDates = case rateSwap t of - Nothing -> [] - Just rsm -> Map.elems $ Map.mapWithKey - (\k x -> let - resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) (HE.rsSettleDates x) endDate + let financialRptDates = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.buildFinancialReport= Just dp } + -> let + _ds = genSerialDatesTill2 II startDate dp endDate + in + [ BuildReport _sd _ed | (_sd,_ed) <- zip _ds (tail _ds) ] -- `debug` ("ds"++ show _ds) + _ -> [] -- `debug` ("emtpy rpt dates") + + let irUpdateSwapDates = case rateSwap t of + Nothing -> [] + Just rsm -> Map.elems $ Map.mapWithKey + (\k x -> let + resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) (HE.rsUpdateDates x) endDate + in + flip CalcIRSwap k <$> resetDs) + rsm + let irSettleSwapDates = case rateSwap t of + Nothing -> [] + Just rsm -> Map.elems $ Map.mapWithKey + (\k x@HE.RateSwap{ HE.rsSettleDates = sDates} -> + case sDates of + Nothing -> [] + Just (sdp,_) -> + let + resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) sdp endDate in - flip ResetIRSwapRate k <$> resetDs) - rsm - rateCapSettleDates = case rateCap t of - Nothing -> [] - Just rcM -> Map.elems $ Map.mapWithKey - (\k x -> let - resetDs = genSerialDatesTill2 EE (HE.rcStartDate x) (HE.rcSettleDates x) endDate - in - flip AccrueCapRate k <$> resetDs) - rcM + flip SettleIRSwap k <$> resetDs) + rsm + let rateCapSettleDates = case rateCap t of + Nothing -> [] + Just rcM -> Map.elems $ Map.mapWithKey + (\k x -> let + resetDs = genSerialDatesTill2 EE (HE.rcStartDate x) (HE.rcSettleDates x) endDate + in + flip AccrueCapRate k <$> resetDs) + rcM -- bond rate resets - bndRateResets = let - bndWithDate = Map.toList $ Map.map - (\b -> L.buildRateResetDates b closingDate endDate) - bndMap - in - [ ResetBondRate bdate bn | (bn,bdates) <- bndWithDate, bdate <- bdates ] - + let bndRateResets = let + bndWithDate = Map.toList $ Map.map + (\b -> L.buildRateResetDates b closingDate endDate) + bndMap + in + [ ResetBondRate bdate bn | (bn, bdates) <- bndWithDate + , bdate <- bdates ] + + -- bond step ups events + let bndStepUpDates = let + bndWithDate = Map.toList $ Map.map + (\b -> L.buildStepUpDates b closingDate endDate) + bndMap + in + [ StepUpBondRate bdate bn | (bn, bdates) <- bndWithDate , bdate <- bdates ] + -- mannual triggers - mannualTrigger = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.fireTrigger = Just evts} -> [ FireTrigger d cycle n | (d,cycle,n) <- evts] - _ -> [] + let mannualTrigger = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.fireTrigger = Just evts} -> [ FireTrigger d cycle n | (d,cycle,n) <- evts] + _ -> [] -- make whole assumption - makeWholeDate = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.makeWholeWhen = Just (_d,_s,_t)} -> [MakeWhole _d _s _t] - _ -> [] + let makeWholeDate = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.makeWholeWhen = Just (_d,_s,_t)} -> [MakeWhole _d _s _t] + _ -> [] -- issue bonds in the future - bondIssuePlan = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.issueBondSchedule = Just bndPlan} - -> [ IssueBond _d mPre bGroupName accName b mBal mRate | TsPoint _d (AP.IssueBondEvent mPre bGroupName accName b mBal mRate) <- bndPlan] - _ -> [] + let bondIssuePlan = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.issueBondSchedule = Just bndPlan} + -> [ IssueBond _d mPre bGroupName accName b mBal mRate | TsPoint _d (AP.IssueBondEvent mPre bGroupName accName b mBal mRate) <- bndPlan] + ++ [FundBond _d mPre bName accName amount | TsPoint _d (AP.FundingBondEvent mPre bName accName amount) <- bndPlan] + _ -> [] -- refinance bonds in the future - bondRefiPlan = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.refinance = Just bndPlan} - -> [ RefiBondRate _d accName bName iInfo | TsPoint _d (AP.RefiRate accName bName iInfo) <- bndPlan] - ++ [ RefiBond _d accName bnd | TsPoint _d (AP.RefiBond accName bnd) <- bndPlan] - - _ -> [] - - extractTestDates (AP.CallOnDates dp _) = [TestCall x | x <- genSerialDatesTill2 EE startDate dp endDate ] - extractTestDates _ = [] + let bondRefiPlan = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.refinance = Just bndPlan} + -> [ RefiBondRate _d accName bName iInfo | TsPoint _d (AP.RefiRate accName bName iInfo) <- bndPlan] + ++ [ RefiBond _d accName bnd | TsPoint _d (AP.RefiBond accName bnd) <- bndPlan] + + _ -> [] + + let extractTestDates (AP.CallOnDates dp _) = [TestCall x | x <- genSerialDatesTill2 EE startDate dp endDate ] + let extractTestDates _ = [] -- extractTestDates (AP.CallOptions opts) = concat [ extractTestDates opt | opt <- opts ] -- call test dates - callDates = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.callWhen = Just callOpts} - -> concat [ extractTestDates callOpt | callOpt <- callOpts ] - _ -> [] - - allActionDates = let - __actionDates = let - a = concat [bActionDates,pActionDates,iAccIntDates,makeWholeDate - ,feeAccrueDates,liqResetDates,mannualTrigger,concat rateCapSettleDates - ,concat irSwapRateDates,inspectDates, bndRateResets,financialRptDates - ,bondIssuePlan,bondRefiPlan,callDates, iAccRateResetDates ] -- `debug` ("reports"++ show financialRptDates) - in - case (dates t,status) of - (PreClosingDates {}, PreClosing _) -> sortBy sortActionOnDate $ DealClosed closingDate:a - _ -> sortBy sortActionOnDate a - _actionDates = __actionDates++[HitStatedMaturity endDate] - in - case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.stopRunBy = Just d} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d] - _ -> _actionDates + let callDates = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.callWhen = Just callOpts} + -> concat [ extractTestDates callOpt | callOpt <- callOpts ] + _ -> [] + + let allActionDates = let + __actionDates = let + a = concat [bActionDates,pActionDates,custWdates,iAccIntDates,makeWholeDate + ,feeAccrueDates,liqResetDates,mannualTrigger,concat rateCapSettleDates + ,concat irUpdateSwapDates, concat irSettleSwapDates ,inspectDates, bndRateResets,financialRptDates + ,bondIssuePlan,bondRefiPlan,callDates, iAccRateResetDates + ,bndStepUpDates] + in + case (dates t,status) of + (PreClosingDates {}, PreClosing _) -> sortBy sortActionOnDate $ DealClosed closingDate:a + _ -> sortBy sortActionOnDate a + _actionDates = __actionDates++[HitStatedMaturity endDate] + in + case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.stopRunBy = Just d} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d] + _ -> _actionDates - newFeeMap = case mNonPerfAssump of - Nothing -> feeMap - Just AP.NonPerfAssumption{AP.projectedExpense = Nothing } -> feeMap - -- Just AP.NonPerfAssumption{AP.projectedExpense = Just (fn,projectedFlow) } - -- -> Map.adjust (\x -> x {F.feeType = F.FeeFlow projectedFlow}) fn feeMap - Just AP.NonPerfAssumption{AP.projectedExpense = Just pairs } - -> foldr (\(feeName,feeFlow) accM -> Map.adjust (\v -> v {F.feeType = F.FeeFlow feeFlow}) feeName accM) feeMap pairs - in - do + let newFeeMap = case mNonPerfAssump of + Nothing -> feeMap + Just AP.NonPerfAssumption{AP.projectedExpense = Nothing } -> feeMap + -- Just AP.NonPerfAssumption{AP.projectedExpense = Just (fn,projectedFlow) } + -- -> Map.adjust (\x -> x {F.feeType = F.FeeFlow projectedFlow}) fn feeMap + Just AP.NonPerfAssumption{AP.projectedExpense = Just pairs } + -> foldr (\(feeName,feeFlow) accM -> Map.adjust (\v -> v {F.feeType = F.FeeFlow feeFlow}) feeName accM) feeMap pairs pCfM <- runPoolType thePool mAssumps mNonPerfAssump pScheduleCfM <- runPoolType thePool Nothing mNonPerfAssump let poolCfTsM = Map.map (\(CF.CashFlowFrame _ txns, pstats) -> cutBy Inc Future startDate txns) pCfM -- `debug` ("Pool cfm"++ show pCfM) @@ -1348,6 +1538,4 @@ depositPoolFlow :: [W.CollectionRule] -> Date -> Map.Map PoolId CF.CashFlowFrame depositPoolFlow rules d pFlowMap amap = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules -$(deriveJSON defaultOptions ''ExpectReturn) - - +$(deriveJSON defaultOptions ''ExpectReturn) \ No newline at end of file diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 33de862f..6b953de2 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -60,18 +60,18 @@ import Data.Aeson.TH import Data.Aeson.Types import GHC.Generics import Control.Applicative - import Debug.Trace import Cashflow (CashFlowFrame(CashFlowFrame)) import Control.Lens hiding (element) import Control.Lens.TH +import Control.Lens.Extras (is) import Control.Monad import GHC.Real (infinity) import Data.OpenApi (HasPatch(patch)) debug = flip trace --- ^ +-- ^ Test triggers testTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Either String Trigger testTrigger t d trigger@Trigger{trgStatus=st,trgCurable=curable,trgCondition=cond,trgStmt = tStmt} | not curable && st = Right trigger @@ -81,7 +81,7 @@ testTrigger t d trigger@Trigger{trgStatus=st,trgCurable=curable,trgCondition=con do newSt <- newStM return trigger { trgStatus = newSt - , trgStmt = Stmt.appendStmt tStmt (TrgTxn d newSt (Stmt.Tag memo))} + , trgStmt = Stmt.appendStmt (TrgTxn d newSt (Stmt.Tag memo)) tStmt } pricingAssets :: PricingMethod -> [(ACM.AssetUnion,AP.AssetPerf)] -> Maybe [RateAssumption] -> Date @@ -95,41 +95,21 @@ pricingAssets pm assetsAndAssump ras d -- actual payout amount to bond with due mounts allocAmtToBonds :: W.PayOrderBy -> Amount -> [(L.Bond,Amount)] -> [(L.Bond,Amount)] +allocAmtToBonds W.ByProRataCurBal amt bndsWithDue + = zip (fst <$> bndsWithDue) $ prorataFactors (snd <$> bndsWithDue) amt allocAmtToBonds theOrder amt bndsWithDue = - case theOrder of - W.ByName -> - let - orderdBonds = sortBy (\(b1,_) (b2,_) -> compare (L.bndName b1) (L.bndName b2)) bndsWithDue - orderedAmt = snd <$> orderdBonds - r = paySeqLiabilitiesAmt amt orderedAmt - in - zip (fst <$> orderdBonds) r - W.ByProRataCurBal -> - let - r = prorataFactors (snd <$> bndsWithDue) amt -- `debug` ("bd amt"++ show amt) - in - zip (fst <$> bndsWithDue) r -- `debug` ("r >>"++ show r) - W.ByCurrentRate -> - let - orderdBonds = sortBy (\(b1,_) (b2,_) -> flip compare (L.bndRate b1) (L.bndRate b2)) bndsWithDue - orderedAmt = snd <$> orderdBonds - r = paySeqLiabilitiesAmt amt orderedAmt - in - zip (fst <$> orderdBonds) r - W.ByMaturity -> - let - orderdBonds = sortBy (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.maturityDate bo1) (L.maturityDate bo2)) bndsWithDue - orderedAmt = snd <$> orderdBonds - r = paySeqLiabilitiesAmt amt orderedAmt - in - zip (fst <$> orderdBonds) r - W.ByStartDate -> - let - orderdBonds = sortBy (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.originDate bo1) (L.originDate bo2)) bndsWithDue - orderedAmt = snd <$> orderdBonds - r = paySeqLiabilitiesAmt amt orderedAmt - in - zip (fst <$> orderdBonds) r + let + sortFn = case theOrder of + W.ByName -> (\(b1,_) (b2,_) -> compare (L.bndName b1) (L.bndName b2)) + W.ByCurrentRate -> (\(b1,_) (b2,_) -> compare (L.bndRate b2) (L.bndRate b1)) + W.ByMaturity -> (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.maturityDate bo1) (L.maturityDate bo2)) + W.ByStartDate -> (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.originDate bo1) (L.originDate bo2)) + orderedBonds = sortBy sortFn bndsWithDue + orderedAmt = snd <$> orderedBonds + in + zip + (fst <$> orderedBonds) + $ paySeqLiabilitiesAmt amt orderedAmt calcDueFee :: Ast.Asset a => TestDeal a -> Date -> F.Fee -> Either String F.Fee @@ -165,9 +145,7 @@ calcDueFee t calcDay f@(F.Fee fn (F.PctFee ds _r ) fs fd fdDay fa lpd _) calcDueFee t calcDay f@(F.Fee fn (F.FeeFlow ts) fs fd _ fa mflpd _) = Right $ - f{ F.feeDue = newFeeDue - ,F.feeDueDate = Just calcDay - ,F.feeType = F.FeeFlow futureDue} + f{ F.feeDue = newFeeDue ,F.feeDueDate = Just calcDay ,F.feeType = F.FeeFlow futureDue} where (currentNewDue,futureDue) = splitTsByDate ts calcDay cumulativeDue = sumValTs currentNewDue @@ -176,7 +154,7 @@ calcDueFee t calcDay f@(F.Fee fn (F.FeeFlow ts) fs fd _ fa mflpd _) calcDueFee t calcDay f@(F.Fee fn (F.RecurFee p amt) fs fd mLastAccDate fa _ _) | periodGaps == 0 = Right f | otherwise = Right f { F.feeDue = amt * fromIntegral periodGaps + fd - , F.feeDueDate = Just (T.addDays 1 calcDay) } -- `debug` ("periods"++show periodGaps) + , F.feeDueDate = Just (T.addDays 1 calcDay) } where accDates = case mLastAccDate of Nothing -> genSerialDatesTill2 NO_IE (T.addDays 1 fs) p calcDay @@ -228,8 +206,8 @@ disableLiqProvider _ d liq@CE.LiqFacility{CE.liqEnds = Just endDate } disableLiqProvider _ d liq@CE.LiqFacility{CE.liqEnds = Nothing } = liq - -- refresh available balance - ---- for Replenish Support and ByPct +-- refresh available balance +---- for Replenish Support and ByPct updateLiqProvider :: Ast.Asset a => TestDeal a -> Date -> CE.LiqFacility -> CE.LiqFacility updateLiqProvider t d liq@CE.LiqFacility{CE.liqType = liqType, CE.liqCredit = curCredit} = disableLiqProvider t d $ liq { CE.liqCredit = newCredit } @@ -238,65 +216,67 @@ updateLiqProvider t d liq@CE.LiqFacility{CE.liqType = liqType, CE.liqCredit = cu newCredit = case liqType of -- CE.ReplenishSupport _ b -> max b <$> curCredit CE.ByPct ds _r -> case (* _r) <$> (queryCompound t d (patchDateToStats d ds)) of - Left y -> Nothing -- TODO tobe fix error - Right x -> (min (fromRational x)) <$> curCredit + Left y -> Nothing -- TODO tobe fix error + Right x -> (min (fromRational x)) <$> curCredit _ -> curCredit - +-- ^TODO : to be replace from L.accrueInt calcDueInt :: Ast.Asset a => TestDeal a -> Date -> Maybe DealStats -> Maybe DealStats -> L.Bond -> Either String L.Bond -calcDueInt t calc_date mBal mRate b@(L.BondGroup bMap) +calcDueInt t d mBal mRate b@(L.BondGroup bMap) = do - m <- mapM (calcDueInt t calc_date mBal mRate) bMap + m <- mapM (calcDueInt t d mBal mRate) bMap return $ L.BondGroup m --- Not accrued -calcDueInt t calc_date mBal mRate b@(L.Bond _ _ oi io _ bal r dp _ di Nothing _ lastPrinPay _ ) - | calc_date <= closingDate = Right b - | bal+di == 0 = Right b - | otherwise = calcDueInt t calc_date mBal mRate (b {L.bndDueIntDate = Just closingDate }) -- `debug` ("hit") - where - closingDate = getClosingDate (dates t) + +-- never accrued +calcDueInt t d mBal mRate b@(L.Bond _ _ oi io _ bal r dp _ di Nothing _ lastPrinPay _ ) + | d <= closingDate = Right b + | bal+di == 0 = Right b + | otherwise = calcDueInt t d mBal mRate (b {L.bndDueIntDate = Just closingDate }) -- `debug` ("hit") + where + closingDate = getClosingDate (dates t) + -- Z bond calcDueInt t calc_date _ _ b@(L.Bond bn L.Z bo bi _ bond_bal bond_rate _ _ _ _ lstIntPay _ _) = Right $ b {L.bndDueInt = 0 } + -- accured by yield -calcDueInt t calc_date _ _ b@(L.Bond bn L.Equity bo (L.InterestByYield y) _ bond_bal _ _ int_due _ _ lstIntPay _ mStmt) +calcDueInt t d _ _ b@(L.Bond bn L.Equity bo (L.InterestByYield y) _ bond_bal _ _ int_due _ _ lstIntPay _ mStmt) = Right $ b {L.bndDueInt = newDue } -- `debug` ("Yield Due Int >>"++ show bn++">> new due"++ show newDue++">> old due"++ show int_due ) where - newDue = L.backoutDueIntByYield calc_date b + newDue = L.backoutDueIntByYield d b + +calcDueInt t d _ _ b@(L.Bond _ L.Equity _ _ _ _ _ _ _ _ _ _ _ _) + = Right $ b + -- accrued with interest over interest -calcDueInt t calc_date mBal mRate b@(L.Bond bn bt bo (L.WithIoI intInfo ioiIntInfo) _ bond_bal bond_rate _ intDue ioiIntDue (Just int_due_date) lstIntPay _ _ ) +calcDueInt t d mBal mRate b@(L.Bond bn bt bo (L.WithIoI intInfo ioiIntInfo) _ bond_bal bond_rate _ intDue ioiIntDue (Just int_due_date) lstIntPay _ _ ) = let ioiRate = case ioiIntInfo of L.OverCurrRateBy factor -> bond_rate * fromRational (1+factor) L.OverFixSpread spd -> bond_rate + spd _ -> error "failed to match ioi rate type" - newIoiInt = IR.calcInt intDue int_due_date calc_date ioiRate DC_ACT_365F + newIoiInt = IR.calcInt intDue int_due_date d ioiRate DC_ACT_365F ioiInt = newIoiInt + ioiIntDue -- add ioi int due with new accrued ioi int newBond = b { L.bndDueIntOverInt = ioiInt, L.bndInterestInfo = intInfo } in do - newBondWithIntInfo <- calcDueInt t calc_date mBal mRate newBond + newBondWithIntInfo <- calcDueInt t d mBal mRate newBond return newBondWithIntInfo { L.bndInterestInfo = L.WithIoI intInfo ioiIntInfo} + +-- TODO: to enable override rate & balance -- accure interest by rate -calcDueInt t calc_date mBal mRate b@(L.Bond bn bt bo bi _ bond_bal bond_rate _ intDue _ (Just int_due_date) lstIntPay _ _ ) - | bond_bal == 0 = Right $ b - | calc_date == int_due_date = Right $ b - | otherwise = - let - dc = case bi of - L.Floater _ _ _ _ _dc _ _ -> _dc - L.Fix _ _dc -> _dc - _ -> DC_ACT_365F - in - do - overrideRate <- maybe (Right bond_rate) ((fromRational <$>) . (queryCompound t calc_date)) mRate - overrideBal <- maybe (Right bond_bal) ((fromRational <$>) . (queryCompound t calc_date)) mBal - let newDueInt = IR.calcInt overrideBal int_due_date calc_date overrideRate dc -- `debug` ("Using Rate"++show calc_date ++">>Bal"++ show overrideBal) - return b {L.bndDueInt = newDueInt+intDue, L.bndDueIntDate = Just calc_date } -- `debug` ("Due INT"++show calc_date ++">>"++show(bn)++">>"++show int_due++">>"++show(new_due_int)) - +calcDueInt t d mBal mRate b@(L.MultiIntBond {}) + = Right $ L.accrueInt d b + +calcDueInt t d _ _ b@(L.Bond {}) + = Right $ L.accrueInt d b + +calcDueInt t d mBal mRate b = error $ "Not implemented for calcDueInt for bond type" ++ show b + + calcDuePrin :: Ast.Asset a => TestDeal a -> Date -> L.Bond -> Either String L.Bond calcDuePrin t d b@(L.BondGroup bMap) = do @@ -311,10 +291,10 @@ calcDuePrin t d b@(L.Bond bn (L.Lockout cd) bo bi _ bondBal _ _ _ _ _ _ _ _) | otherwise = Right $ b {L.bndDuePrin = bondBal } calcDuePrin t d b@(L.Bond bn (L.PAC schedule) _ _ _ bondBal _ _ _ _ _ _ _ _) - = Right $ b {L.bndDuePrin = duePrin} -- `debug` ("bn >> "++bn++"Due Prin set=>"++show(duePrin) ) + = Right $ b {L.bndDuePrin = duePrin} where scheduleDue = getValOnByDate schedule d - duePrin = max (bondBal - scheduleDue) 0 -- `debug` ("In PAC ,target balance"++show(schedule)++show(calc_date)++show(scheduleDue)) + duePrin = max (bondBal - scheduleDue) 0 calcDuePrin t d b@(L.Bond bn (L.PacAnchor schedule bns) _ _ _ bondBal _ _ _ _ _ _ _ _) = let @@ -348,6 +328,9 @@ calcDuePrin t calc_date b@(L.Bond bn L.Z bo bi _ bond_bal bond_rate prin_arr int calcDuePrin t calc_date b@(L.Bond bn L.Equity bo bi _ bondBal _ _ _ _ _ _ _ _) = Right $ b {L.bndDuePrin = bondBal } +-- TODO: add more generic to handle with MultiIntBond +calcDuePrin t d b@(L.MultiIntBond _ L.Sequential _ _ _ bondBal _ _ _ _ _ _ _ _) + = Right $ b {L.bndDuePrin = bondBal } priceAssetUnion :: ACM.AssetUnion -> Date -> PricingMethod -> AP.AssetPerf -> Maybe [RateAssumption] -> Either String PriceResult @@ -364,7 +347,6 @@ priceAssetUnionList :: [ACM.AssetUnion] -> Date -> PricingMethod -> AP.ApplyAss priceAssetUnionList assetList d pm (AP.PoolLevel assetPerf) mRates = sequenceA [ priceAssetUnion asset d pm assetPerf mRates | asset <- assetList ] - -- | this would used in `static` revolving ,which assumes the revolving pool will decrease splitAssetUnion :: [Rate] -> ACM.AssetUnion -> [ACM.AssetUnion] splitAssetUnion rs (ACM.MO m) = [ ACM.MO a | a <- Ast.splitWith m rs] @@ -444,16 +426,18 @@ evalExtraSupportBalance d t (W.MultiSupport supports) -- ^ draw support from a deal , return updated deal,and remaining oustanding amount -drawExtraSupport :: Date -> Amount -> W.ExtraSupport -> TestDeal a -> (TestDeal a,Amount) -drawExtraSupport d amt (W.SupportAccount an (Just (W.ByAccountDraw ln))) t@TestDeal{accounts=accMap, ledgers= Just ledgerMap} +drawExtraSupport :: Date -> Amount -> W.ExtraSupport -> TestDeal a -> (TestDeal a, Amount) +-- ^ draw account support and book ledger +drawExtraSupport d amt (W.SupportAccount an (Just (dr, ln))) t@TestDeal{accounts=accMap, ledgers= Just ledgerMap} = let drawAmt = min (A.accBalance (accMap Map.! an)) amt oustandingAmt = amt - drawAmt in (t {accounts = Map.adjust (A.draw drawAmt d Types.SupportDraw) an accMap - ,ledgers = Just $ Map.adjust (LD.entryLog drawAmt d (TxnDirection Debit)) ln ledgerMap} + ,ledgers = Just $ Map.adjust (LD.entryLog drawAmt d (TxnDirection dr)) ln ledgerMap} , oustandingAmt) +-- ^ draw account support drawExtraSupport d amt (W.SupportAccount an Nothing) t@TestDeal{accounts=accMap} = let drawAmt = min (A.accBalance (accMap Map.! an)) amt @@ -462,6 +446,7 @@ drawExtraSupport d amt (W.SupportAccount an Nothing) t@TestDeal{accounts=accMap} (t {accounts = Map.adjust (A.draw drawAmt d Types.SupportDraw) an accMap } , oustandingAmt) +-- ^ draw support from liquidity facility drawExtraSupport d amt (W.SupportLiqFacility liqName) t@TestDeal{liqProvider= Just liqMap} = let theLiqProvider = liqMap Map.! liqName @@ -473,10 +458,11 @@ drawExtraSupport d amt (W.SupportLiqFacility liqName) t@TestDeal{liqProvider= Ju (t {liqProvider = Just (Map.adjust (CE.draw drawAmt d) liqName liqMap)} , oustandingAmt) +-- ^ draw multiple supports by sequence drawExtraSupport d amt (W.MultiSupport supports) t = foldr (\support (deal,remainAmt) -> drawExtraSupport d remainAmt support deal) - (t,amt) + (t, amt) supports inspectListVars :: Ast.Asset a => TestDeal a -> Date -> [DealStats] -> Either String [ResultComponent] @@ -518,8 +504,8 @@ applyLimit t d availBal dueBal (Just limit) = case limit of DueCapAmt amt -> Right $ min amt availBal DS ds -> do - v <- queryCompound t d (patchDateToStats d ds) - return (min (fromRational v) availBal) + v <- queryCompound t d (patchDateToStats d ds) + return (min (fromRational v) availBal) DuePct pct -> Right $ min availBal $ mulBR dueBal pct x -> Left $ "Date:"++show d ++" Unsupported limit found:"++ show x @@ -554,7 +540,7 @@ performActionWrap :: Ast.Asset a => Date -> (TestDeal a, RunContext a, [ResultCo -> W.Action -> Either String (TestDeal a, RunContext a, [ResultComponent]) performActionWrap d (t, rc, logs) (W.BuyAsset ml pricingMethod accName pId) - = performActionWrap d (t, rc, logs) (W.BuyAssetFrom ml pricingMethod accName (Just "Consol") pId) + = performActionWrap d (t, rc, logs) (W.BuyAssetFrom ml pricingMethod accName (Just "Consol") pId) performActionWrap d (t@TestDeal{ accounts = accsMap , pool = pt} @@ -563,7 +549,7 @@ performActionWrap d ,revolvingInterestRateAssump = mRates} ,logs) (W.BuyAssetFrom ml pricingMethod accName mRevolvingPoolName pId) - = + = let revolvingPoolName = fromMaybe "Consol" mRevolvingPoolName (assetForSale::RevolvingPool, perfAssumps::AP.ApplyAssumptionType) = rMap Map.! revolvingPoolName -- `debug` ("Getting pool"++ revolvingPoolName) @@ -578,6 +564,7 @@ performActionWrap d limitAmt <- case ml of Just (DS ds) -> queryCompound t d (patchDateToStats d ds) Just (DueCapAmt amt) -> Right (toRational amt) + Just (DuePct pct) -> Right $ toRational (mulBR accBal pct) Nothing -> Right (toRational accBal) let availBal = min (fromRational limitAmt) accBal -- `debug` ("Date"++ show d ++" Value on r -asset "++ show valuationOnAvailableAssets) valOnAvailableAssets <- priceAssetUnionList assets d pricingMethod perfAssumps mRates @@ -653,26 +640,25 @@ performActionWrap d poolMapToLiq = case (pt, mPid) of (MultiPool pm, Nothing) -> pm (MultiPool pm,Just pids) -> let - selectedPids = S.fromList pids - selectedPoolMap = Map.filterWithKey (\k v -> S.member k selectedPids) pm + selectedPids = S.fromList pids in - selectedPoolMap + Map.filterWithKey (\k v -> S.member k selectedPids) pm + (ResecDeal _,_) -> error "Not implement on liquidate resec deal" - + liqAmtByPool = Map.mapWithKey (\k p -> P.pricingPoolFlow d p (pcf Map.! k) lm) poolMapToLiq -- `debug` ("pool id to liq"++ show poolMapToLiq) - liqAmt = sum $ Map.elems liqAmtByPool -- Update collected cashflow newPt = case (pt, mPid) of (MultiPool pm, Nothing) -> MultiPool $ Map.map liqFunction pm (MultiPool pm, Just pids) -> let - selectedPids = S.fromList pids - selectedPoolMap = Map.filterWithKey (\k v -> S.member k selectedPids) pm - in - MultiPool $ Map.union (Map.map liqFunction selectedPoolMap) pm + selectedPids = S.fromList pids + selectedPoolMap = Map.filterWithKey (\k v -> S.member k selectedPids) pm + in + MultiPool $ Map.union (Map.map liqFunction selectedPoolMap) pm (ResecDeal _,_) -> error "Not implement on liquidate resec deal" liqComment = LiquidationProceeds (fromMaybe [] mPid) @@ -686,7 +672,7 @@ performActionWrap d performActionWrap d (t, rc, logs) (W.WatchVal ms dss) = (inspectListVars t d dss) >>= (\vs -> Right (t, rc, logs ++ [InspectWaterfall d ms dss (showInspection <$> vs)])) - -- vals <- sequenceA $ showInspection (inspectListVars t d dss) + performActionWrap d (t, rc, logs) (W.ActionWithPre p actions) = do @@ -757,6 +743,13 @@ performAction d t@TestDeal{accounts=accMap} (W.TransferMultiple sourceAccList ta sourceAccList -- ^ book ledger +performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.Till ledger dr ds)) = + do + targetAmt <- queryCompound t d ds + let (bookDirection, amtToBook) = LD.bookToTarget (ledgerM Map.! ledger) (dr, fromRational targetAmt) + let newLedgerM = Map.adjust (LD.entryLogByDr bookDirection amtToBook d Nothing) ledger ledgerM + return $ t {ledgers = Just newLedgerM } + performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.ByDS ledger dr ds)) = do amtToBook <- queryCompound t d ds @@ -781,7 +774,7 @@ performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.PDL dr ds ledgers (zip ledgerNames amtBookedToLedgers) --`debug` ("amts to book"++ show amtBookedToLedgers) return $ t {ledgers = Just newLedgerM} --- ^ pay fee sequentially +-- ^ pay fee sequentially, but not accrued performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFeeBySeq mLimit an fns mSupport) = let availAccBal = A.accBalance (accMap Map.! an) @@ -830,13 +823,13 @@ performAction d t@TestDeal{bonds=bndMap, accounts=accMap, liqProvider=liqMap} = let availAccBal = A.accBalance (accMap Map.! an) bndsList = (Map.!) bndMap <$> bnds - dueAmts = L.bndDueIntOverInt <$> bndsList + dueAmts = L.getDueIntOverInt <$> bndsList totalDue = sum dueAmts actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit in do paidOutAmt <- actualPaidOut - let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.bndDueIntOverInt (L.payInt d) [] bndsList + let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.getDueIntOverInt (L.payInt d) [] bndsList let accPaidOut = min availAccBal paidOutAmt let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap @@ -851,13 +844,13 @@ performAction d t@TestDeal{bonds=bndMap, accounts=accMap, liqProvider=liqMap} = let availAccBal = A.accBalance (accMap Map.! an) bndsList = (Map.!) bndMap <$> bnds - dueAmts = L.bndDueInt <$> bndsList + dueAmts = L.getTotalDueInt <$> bndsList totalDue = sum dueAmts actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit in do paidOutAmt <- actualPaidOut - let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.bndDueInt (L.payInt d) [] bndsList + let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.getTotalDueInt (L.payInt d) [] bndsList let accPaidOut = min availAccBal paidOutAmt let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap @@ -867,17 +860,18 @@ performAction d t@TestDeal{bonds=bndMap, accounts=accMap, liqProvider=liqMap} return $ updateSupport d mSupport supportPaidOut dealAfterAcc -performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntOverInt mLimit an bnds mSupport) +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} + (W.PayIntOverInt mLimit an bnds mSupport) = let availAccBal = A.accBalance (accMap Map.! an) bndsList = (Map.!) bndMap <$> bnds - dueAmts = L.bndDueIntOverInt <$> bndsList + dueAmts = L.getDueIntOverInt <$> bndsList totalDue = sum dueAmts actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit in do paidOutAmt <- actualPaidOut - let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.bndDueIntOverInt (L.payInt d) bndsList + let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.getDueIntOverInt (L.payInt d) bndsList let accPaidOut = min availAccBal paidOutAmt let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap @@ -886,17 +880,18 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntOverInt mLimit let supportPaidOut = paidOutAmt - accPaidOut return $ updateSupport d mSupport supportPaidOut dealAfterAcc -performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayInt mLimit an bnds mSupport) +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} + (W.PayInt mLimit an bnds mSupport) = let availAccBal = A.accBalance (accMap Map.! an) bndsList = (Map.!) bndMap <$> bnds - dueAmts = L.bndDueInt <$> bndsList + dueAmts = L.getTotalDueInt <$> bndsList totalDue = sum dueAmts actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit in do paidOutAmt <- actualPaidOut - let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.bndDueInt (L.payInt d) bndsList + let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.getTotalDueInt (L.payInt d) bndsList let accPaidOut = (min availAccBal paidOutAmt) let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap @@ -905,6 +900,30 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayInt mLimit an bnd let supportPaidOut = paidOutAmt - accPaidOut return $ updateSupport d mSupport supportPaidOut dealAfterAcc +performAction d t@TestDeal{bonds=bndMap,accounts=accMap,ledgers= Just ledgerM} + (W.PayIntAndBook mLimit an bnds mSupport (dr, lName)) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = (Map.!) bndMap <$> bnds + dueAmts = L.getTotalDueInt <$> bndsList + totalDue = sum dueAmts + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.getTotalDueInt (L.payInt d) bndsList + let accPaidOut = (min availAccBal paidOutAmt) + let newLedgerM = Map.adjust (LD.entryLogByDr dr paidOutAmt d Nothing) lName ledgerM + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap + ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap + ,ledgers = Just newLedgerM} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + + + performAction d t (W.AccrueAndPayInt mLimit an bnds mSupport) = do dealWithBondDue <- performAction d t (W.CalcBondInt bnds Nothing Nothing) @@ -924,6 +943,39 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntResidual mLimi return $ t {accounts = Map.adjust (A.draw limitAmt d (PayYield bndName)) an accMap , bonds = Map.adjust (L.payYield d limitAmt) bndName bndMap} + +-- TODO index out of bound check +-- TODO check for multi interest bond +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} + (W.PayIntByRateIndex mLimit an bndNames idx mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = filter (is L._MultiIntBond) $ (Map.!) bndMap <$> bndNames + bndNames_ = L.bndName <$> bndsList + in + do + totalDue <- queryCompound t d (CurrentDueBondIntTotalAt idx bndNames_) + actualPaidOut <- calcAvailAfterLimit t d (accMap Map.! an) mSupport (fromRational totalDue) mLimit -- `debug` ("Date "++ show d ++" total due"++show (fromRational totalDue)) + let (paidBonds, _) = payProRata d actualPaidOut (`L.getTotalDueIntAt` idx) (L.payIntByIndex d idx) bndsList -- `debug` ("Date"++show d++" paid out amt"++show (L.bndDueInts (paidBonds!!0))) + let accMap1 = accMap -- `debug` ("Date"++show d++" paid out amt"++show (L.bndDueInts (paidBonds!!0))) + return $ t {accounts = Map.adjust (A.draw actualPaidOut d (PayInt bndNames_)) an accMap1 + , bonds = Map.fromList (zip bndNames_ paidBonds) <> bndMap} + + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntByRateIndexBySeq mLimit an bndNames idx mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = filter (is L._MultiIntBond) $ (Map.!) bndMap <$> bndNames + bndNames_ = L.bndName <$> bndsList + in + do + totalDue <- queryCompound t d (CurrentDueBondIntAt idx bndNames_) + actualPaidOut <- calcAvailAfterLimit t d (accMap Map.! an) mSupport (fromRational totalDue) mLimit + let (paidBonds, _) = paySequentially d actualPaidOut (`L.getTotalDueIntAt` idx) (L.payIntByIndex d idx) [] bndsList + return $ t {accounts = Map.adjust (A.draw actualPaidOut d (PayInt bndNames_)) an accMap + , bonds = Map.fromList (zip bndNames_ paidBonds) <> bndMap} + + performAction d t@TestDeal{fees=feeMap,accounts=accMap} (W.PayFeeResidual mlimit an feeName) = let availBal = A.accBalance $ accMap Map.! an @@ -945,10 +997,10 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} do bndsWithDue <- sequenceA $ calcDuePrin t d <$> bndsToPay let bndsDueAmts = L.bndDuePrin <$> bndsWithDue - let totalDue = sum bndsDueAmts + let totalDue = sum bndsDueAmts -- `debug` ("Date"++show d++" due amt"++show bndsDueAmts) let actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit - paidOutAmt <- actualPaidOut - let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.bndDuePrin (L.payPrin d) [] bndsToPay + paidOutAmt <- actualPaidOut -- `debug` ("Date"++show d++" paid out amt"++show actualPaidOut) + let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.bndDuePrin (L.payPrin d) [] bndsWithDue let accPaidOut = min availAccBal paidOutAmt let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayPrin bndsToPayNames)) an accMap @@ -988,19 +1040,20 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} return $ updateSupport d mSupport supportPaidOut dealAfterAcc +-- ^ accure interest and payout interest to a bond group with sequence input "by" performAction d t@TestDeal{bonds=bndMap} (W.AccrueAndPayIntGroup mLimit an bndName by mSupport) = do dAfterAcc <- performAction d t (W.AccrueIntGroup [bndName])-- `debug` ("Acc due int grp"++ show (getDueInt (bndMap Map.! bndName))) performAction d dAfterAcc (W.PayIntGroup mLimit an bndName by mSupport) - +-- ^ accrue interest for a group of bonds performAction d t@TestDeal{bonds=bndMap} (W.AccrueIntGroup bndNames) = do let bondGrp = Map.filterWithKey (\k _ -> S.member k (S.fromList bndNames)) bndMap bondGrpAccrued <- mapM (calcDueInt t d Nothing Nothing) bondGrp return t {bonds = bondGrpAccrued <> bndMap} - +-- ^ pay interest for a group of bonds with sequence input "by" performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntGroup mLimit an bndGrpName by mSupport) = let availAccBal = A.accBalance (accMap Map.! an) @@ -1010,7 +1063,7 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntGroup mLimit a in do bndsWithDueMap <- mapM (calcDueInt t d Nothing Nothing) bndsToPay - let bndsDueAmtsMap = Map.map (\x -> (x, L.totalDueInt x)) bndsWithDueMap + let bndsDueAmtsMap = Map.map (\x -> (x, L.getTotalDueInt x)) bndsWithDueMap let totalDue = sum $ snd <$> Map.elems bndsDueAmtsMap -- `debug` (">date"++show d++" due amt"++show bndsDueAmtsMap) let actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit paidOutAmt <- actualPaidOut @@ -1051,7 +1104,6 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayPrin mLimit an bn = let availAccBal = A.accBalance (accMap Map.! an) bndsToPay = getActiveBonds t bnds - in do bndsWithDue <- sequenceA $ calcDuePrin t d <$> bndsToPay @@ -1090,9 +1142,9 @@ performAction d t@TestDeal{accounts=accMap, bonds=bndMap} (W.PayPrinResidual an performAction d t@TestDeal{accounts=accMap, bonds=bndMap} (W.FundWith mlimit an bnd) = do fundAmt_ <- case mlimit of - Just (DS ds) -> queryCompound t d (patchDateToStats d ds) - Just (DueCapAmt amt) -> Right $ toRational amt - _ -> Left $ "Date:"++show d ++"Not valid limit for funding with bond"++ show bnd + Just (DS ds) -> queryCompound t d (patchDateToStats d ds) + Just (DueCapAmt amt) -> Right $ toRational amt + _ -> Left $ "Date:"++show d ++"Not valid limit for funding with bond"++ show bnd let fundAmt = fromRational fundAmt_ let accMapAfterFund = Map.adjust (A.deposit fundAmt d (FundWith bnd fundAmt)) an accMap newBnd <- calcDueInt t d Nothing Nothing $ bndMap Map.! bnd @@ -1192,7 +1244,7 @@ performAction d t@TestDeal{bonds=bndMap, accounts = accMap} (W.CalcBondPrin mLim bndMap bndsAmountToBePaid -- `debug` ("Calc Bond Prin"++ show bndsAmountToBePaid) return $ t {bonds = newBndMap} - + -- ^ draw cash and deposit to account performAction d t@TestDeal{accounts=accs, liqProvider = Just _liqProvider} (W.LiqSupport mLimit pName CE.LiqToAcc ans) @@ -1210,8 +1262,7 @@ performAction d t@TestDeal{accounts=accs, liqProvider = Just _liqProvider} (W.Li (_ , Just _x) -> Left $ "Date:"++show d ++"Not support limit in LiqSupport(Account)"++ show _x let dAmt = fromRational transferAmt return t { accounts = Map.adjust (A.deposit dAmt d (LiquidationSupport pName)) an accs - , liqProvider = Just $ Map.adjust (CE.draw dAmt d) pName _liqProvider - } + , liqProvider = Just $ Map.adjust (CE.draw dAmt d) pName _liqProvider } | otherwise = Left $ "Date:"++show d ++"There should only one account for LiqToAcc of LiqSupport" @@ -1234,7 +1285,8 @@ performAction d t@TestDeal{fees=feeMap,liqProvider = Just _liqProvider} (W.LiqSu -- TODO : add pay int by sequence -- TODO : may not work for bond group -performAction d t@TestDeal{bonds=bndMap,liqProvider = Just _liqProvider} (W.LiqSupport mLimit pName CE.LiqToBondInt bns) +performAction d t@TestDeal{bonds=bndMap,liqProvider = Just _liqProvider} + (W.LiqSupport mLimit pName CE.LiqToBondInt bns) = let liq = _liqProvider Map.! pName in @@ -1246,7 +1298,7 @@ performAction d t@TestDeal{bonds=bndMap,liqProvider = Just _liqProvider} (W.LiqS Nothing -> supportAmt (Just v) -> min supportAmt v - let newBondMap = payInMap d transferAmt L.totalDueInt (L.payInt d) bns ByProRata bndMap + let newBondMap = payInMap d transferAmt L.getTotalDueInt (L.payInt d) bns ByProRata bndMap let newLiqMap = Map.adjust (CE.draw transferAmt d) pName _liqProvider return $ t { bonds = newBondMap, liqProvider = Just newLiqMap } @@ -1275,8 +1327,8 @@ performAction d t@TestDeal{accounts=accs,liqProvider = Just _liqProvider} (W.Liq let paidOutsToLiq = paySeqLiabilitiesAmt transferAmt dueBreakdown let rptsToPair = case rpt of - CE.LiqRepayTypes lrts -> lrts - x -> [x] + CE.LiqRepayTypes lrts -> lrts + x -> [x] let paidOutWithType | overDrawnBalance > 0 = zip (CE.LiqOD:rptsToPair) paidOutsToLiq @@ -1317,7 +1369,7 @@ performAction d t@TestDeal{rateSwap = Just rtSwap } (W.SwapAccrue sName) (HE.Fixed b) -> Right b (HE.Base ds) -> fromRational <$> queryCompound t d (patchDateToStats d ds) (HE.Schedule ts) -> Right . fromRational $ getValByDate ts Inc d - + let newRtSwap = Map.adjust (HE.accrueIRS d) sName @@ -1325,30 +1377,41 @@ performAction d t@TestDeal{rateSwap = Just rtSwap } (W.SwapAccrue sName) return $ t { rateSwap = Just newRtSwap } -performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapReceive accName sName) - = Right $ t { rateSwap = Just newRtSwap, accounts = newAccMap } - where - receiveAmt = max 0 $ HE.rsNetCash $ rtSwap Map.! sName - newRtSwap = Map.adjust (HE.receiveIRS d) sName rtSwap -- `debug` ("REceiv AMT"++ show receiveAmt) - newAccMap = Map.adjust (A.deposit receiveAmt d SwapInSettle) accName accsMap - - performAction d t@TestDeal{rateCap = Just rcM, accounts = accsMap } (W.CollectRateCap accName sName) = Right $ t { rateCap = Just newRcSwap, accounts = newAccMap } where receiveAmt = max 0 $ HE.rcNetCash $ rcM Map.! sName newRcSwap = Map.adjust (HE.receiveRC d) sName rcM -- `debug` ("REceiv AMT"++ show receiveAmt) - newAccMap = Map.adjust (A.deposit receiveAmt d SwapInSettle) accName accsMap + newAccMap = Map.adjust (A.deposit receiveAmt d (SwapInSettle sName)) accName accsMap +performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapReceive accName sName) + = case (Map.member accName accsMap, Map.member sName rtSwap) of + (False, _) -> Left $ "Date:"++show d ++"Account:"++ show accName ++"not found in SwapReceive" + (_, False) -> Left $ "Date:"++show d ++"Swap:"++ show sName ++"not found in SwapReceive" + _ -> let + receiveAmt = max 0 $ HE.rsNetCash $ rtSwap Map.! sName + newRtSwap = Map.adjust (HE.receiveIRS d) sName rtSwap + newAccMap = Map.adjust (A.deposit receiveAmt d (SwapInSettle sName)) accName accsMap + in + Right $ t { rateSwap = Just newRtSwap, accounts = newAccMap } + performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapPay accName sName) - = Right $ t { rateSwap = Just newRtSwap, accounts = newAccMap } - where - payoutAmt = negate $ HE.rsNetCash $ rtSwap Map.! sName - availBal = A.accBalance $ accsMap Map.! accName - amtToPay = min payoutAmt availBal - newRtSwap = Map.adjust (HE.payoutIRS d amtToPay) sName rtSwap - newAccMap = Map.adjust (A.draw amtToPay d SwapOutSettle) accName accsMap + = case (Map.member accName accsMap, Map.member sName rtSwap) of + (False, _) -> Left $ "Date:"++show d ++"Account:"++ show accName ++"not found in SwapPay" + (_, False) -> Left $ "Date:"++show d ++"Swap:"++ show sName ++"not found in SwapPay" + _ -> if (HE.rsNetCash (rtSwap Map.! sName)) < 0 then + let + payoutAmt = negate $ HE.rsNetCash $ rtSwap Map.! sName + availBal = A.accBalance $ accsMap Map.! accName + amtToPay = min payoutAmt availBal + newRtSwap = Map.adjust (HE.payoutIRS d amtToPay) sName rtSwap + newAccMap = Map.adjust (A.draw amtToPay d (SwapOutSettle sName)) accName accsMap + in + Right $ t { rateSwap = Just newRtSwap, accounts = newAccMap } + else + Right t + performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapSettle accName sName) = do diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index 3bc8782c..98934e17 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -66,18 +66,21 @@ data ActionOnDate = EarnAccInt Date AccName -- ^ sweep bank account | ResetLiqProvider Date String -- ^ reset credit for liquidity provider | ResetLiqProviderRate Date String -- ^ accure interest/premium amount for liquidity provider | PoolCollection Date String -- ^ collect pool cashflow and deposit to accounts - | RunWaterfall Date String -- ^ execute waterfall + | RunWaterfall Date String -- ^ execute waterfall on distribution date | DealClosed Date -- ^ actions to perform at the deal closing day, and enter a new deal status | FireTrigger Date DealCycle String -- ^ fire a trigger | InspectDS Date [DealStats] -- ^ inspect formulas - | ResetIRSwapRate Date String -- ^ reset interest rate swap dates + | CalcIRSwap Date String -- ^ calc interest rate swap dates + | SettleIRSwap Date String -- ^ settle interest rate swap dates | AccrueCapRate Date String -- ^ reset interest rate cap dates | ResetBondRate Date String -- ^ reset bond interest rate per bond's interest rate info + | StepUpBondRate Date String -- ^ reset bond interest rate per bond's interest rate info | ResetSrtRate Date String | ResetAccRate Date String | AccrueSrt Date String | MakeWhole Date Spread (Table Float Spread) | IssueBond Date (Maybe Pre) String AccName L.Bond (Maybe DealStats) (Maybe DealStats) + | FundBond Date (Maybe Pre) String AccName Amount | RefiBondRate Date AccountName BondName L.InterestInfo | RefiBond Date AccountName L.Bond | BuildReport StartDate EndDate -- ^ build cashflow report between dates and balance report at end date @@ -103,9 +106,11 @@ instance TimeSeries ActionOnDate where getDate (FireTrigger d _ _) = d getDate (ChangeDealStatusTo d _ ) = d getDate (InspectDS d _ ) = d - getDate (ResetIRSwapRate d _ ) = d + getDate (CalcIRSwap d _ ) = d + getDate (SettleIRSwap d _ ) = d getDate (AccrueCapRate d _ ) = d - getDate (ResetBondRate d _ ) = d + getDate (ResetBondRate d _) = d + getDate (StepUpBondRate d _) = d getDate (ResetAccRate d _ ) = d getDate (MakeWhole d _ _) = d getDate (BuildReport sd ed) = ed @@ -114,29 +119,35 @@ instance TimeSeries ActionOnDate where getDate (RefiBond d _ _) = d getDate (ResetLiqProviderRate d _) = d getDate (TestCall d) = d + getDate (FundBond d _ _ _ _) = d getDate x = error $ "Failed to match"++ show x sortActionOnDate :: ActionOnDate -> ActionOnDate -> Ordering sortActionOnDate a1 a2 | d1 == d2 = case (a1,a2) of - (PoolCollection {}, DealClosed {}) -> LT -- pool collection should be executed before deal closed - (DealClosed {}, PoolCollection {}) -> GT -- pool collection should be executed before deal closed - (BuildReport sd1 ed1 ,_) -> GT -- build report should be executed last - (_ , BuildReport sd1 ed1) -> LT -- build report should be executed last - (TestCall _ ,_) -> GT -- build report should be executed last - (_ , TestCall _) -> LT -- build report should be executed last - (ResetIRSwapRate _ _ ,_) -> LT -- reset interest swap should be first - (_ , ResetIRSwapRate _ _) -> GT -- reset interest swap should be first - (ResetBondRate {} ,_) -> LT -- reset bond rate should be first - (_ , ResetBondRate {}) -> GT -- reset bond rate should be first - (EarnAccInt {} ,_) -> LT -- earn should be first - (_ , EarnAccInt {}) -> GT -- earn should be first - (ResetLiqProvider {} ,_) -> LT -- reset liq be first - (_ , ResetLiqProvider {}) -> GT -- reset liq be first - (PoolCollection {}, RunWaterfall {}) -> LT -- pool collection should be executed before waterfall - (RunWaterfall {}, PoolCollection {}) -> GT -- pool collection should be executed before waterfall - (_,_) -> EQ + (PoolCollection {}, DealClosed {}) -> LT -- pool collection should be executed before deal closed + (DealClosed {}, PoolCollection {}) -> GT -- pool collection should be executed before deal closed + (BuildReport sd1 ed1 ,_) -> GT -- build report should be executed last + (_ , BuildReport sd1 ed1) -> LT -- build report should be executed last + (TestCall _ ,_) -> GT -- test call should be executed last + (_ , TestCall _) -> LT -- test call should be executed last + (CalcIRSwap _ _ ,SettleIRSwap _ _) -> LT -- reset interest swap should be first + (SettleIRSwap _ _ ,CalcIRSwap _ _) -> GT -- reset interest swap should be first + (_ , CalcIRSwap _ _) -> GT -- reset interest swap should be first + (CalcIRSwap _ _ ,_) -> LT -- reset interest swap should be first + (_ , CalcIRSwap _ _) -> GT -- reset interest swap should be first + (StepUpBondRate {} ,_) -> LT -- step up bond rate should be first + (_ , StepUpBondRate {}) -> GT -- step up bond rate should be first + (ResetBondRate {} ,_) -> LT -- reset bond rate should be first + (_ , ResetBondRate {}) -> GT -- reset bond rate should be first + (EarnAccInt {} ,_) -> LT -- earn should be first + (_ , EarnAccInt {}) -> GT -- earn should be first + (ResetLiqProvider {} ,_) -> LT -- reset liq be first + (_ , ResetLiqProvider {}) -> GT -- reset liq be first + (PoolCollection {}, RunWaterfall {}) -> LT -- pool collection should be executed before waterfall + (RunWaterfall {}, PoolCollection {}) -> GT -- pool collection should be executed before waterfall + (_,_) -> EQ | otherwise = compare d1 d2 where d1 = getDate a1 @@ -159,11 +170,11 @@ data DateDesp = FixInterval (Map.Map DateType Date) Period Period | PatternInterval (Map.Map DateType (Date, DatePattern, Date)) -- cutoff closing mRevolving end-date dp1-pc dp2-bond-pay | PreClosingDates CutoffDate ClosingDate (Maybe RevolvingDate) StatedDate (Date,PoolCollectionDates) (Date,DistributionDates) - -- (start date, ramp action dp) -- - | WarehousingDates Date PoolCollectionDates DistributionDates StatedDate -- (last collect,last pay), mRevolving end-date dp1-pool-pay dp2-bond-pay | CurrentDates (Date,Date) (Maybe Date) StatedDate (Date,PoolCollectionDates) (Date,DistributionDates) + -- Dict based + | GenericDates (Map.Map DateType DatePattern) deriving (Show,Eq, Generic,Ord) @@ -215,34 +226,31 @@ data PoolType a = MultiPool (Map.Map PoolId (P.Pool a)) deriving (Generic, Eq, Ord, Show) - - - data TestDeal a = TestDeal { name :: DealName - ,status :: DealStatus - ,dates :: DateDesp - ,accounts :: Map.Map AccountName A.Account - ,fees :: Map.Map FeeName F.Fee - ,bonds :: Map.Map BondName L.Bond - ,pool :: PoolType a - ,waterfall :: Map.Map W.ActionWhen W.DistributionSeq - ,collects :: [W.CollectionRule] - ,call :: Maybe [C.CallOption] - ,liqProvider :: Maybe (Map.Map String CE.LiqFacility) - ,rateSwap :: Maybe (Map.Map String HE.RateSwap) - ,rateCap :: Maybe (Map.Map String HE.RateCap) - ,currencySwap :: Maybe (Map.Map String HE.CurrencySwap) - ,custom:: Maybe (Map.Map String CustomDataType) - ,triggers :: Maybe (Map.Map DealCycle (Map.Map String Trigger)) - ,overrides :: Maybe [OverrideType] - ,ledgers :: Maybe (Map.Map String LD.Ledger) - } deriving (Show,Generic,Eq,Ord) + ,status :: DealStatus + ,dates :: DateDesp + ,accounts :: Map.Map AccountName A.Account + ,fees :: Map.Map FeeName F.Fee + ,bonds :: Map.Map BondName L.Bond + ,pool :: PoolType a + ,waterfall :: Map.Map W.ActionWhen W.DistributionSeq + ,collects :: [W.CollectionRule] + ,call :: Maybe [C.CallOption] + ,liqProvider :: Maybe (Map.Map String CE.LiqFacility) + ,rateSwap :: Maybe (Map.Map String HE.RateSwap) + ,rateCap :: Maybe (Map.Map String HE.RateCap) + ,currencySwap :: Maybe (Map.Map String HE.CurrencySwap) + ,custom:: Maybe (Map.Map String CustomDataType) + ,triggers :: Maybe (Map.Map DealCycle (Map.Map String Trigger)) + ,overrides :: Maybe [OverrideType] + ,ledgers :: Maybe (Map.Map String LD.Ledger) + } deriving (Show,Generic,Eq,Ord) instance SPV (TestDeal a) where getBondsByName t bns = case bns of - Nothing -> bonds t - Just _bns -> Map.filterWithKey (\k _ -> S.member k (S.fromList _bns)) (bonds t) + Nothing -> bonds t + Just _bns -> Map.filterWithKey (\k _ -> S.member k (S.fromList _bns)) (bonds t) getActiveBonds t bns = let @@ -281,16 +289,6 @@ instance SPV (TestDeal a) where ResecDeal _ -> True _ -> False -_expandBonds :: Map.Map BondName L.Bond -> [L.Bond] -_expandBonds bMap = - let - bs = Map.elems bMap - view a@(L.Bond {}) = [a] - view a@(L.BondGroup bMap) = Map.elems bMap - in - concat $ view <$> bs - - -- ^ list all bonds and bond groups in list viewDealAllBonds :: TestDeal a -> [L.Bond] viewDealAllBonds d = @@ -298,6 +296,7 @@ viewDealAllBonds d = bs = Map.elems (bonds d) view a@(L.Bond {} ) = [a] view a@(L.BondGroup bMap) = Map.elems bMap + view a@(L.MultiIntBond {}) = [a] in concat $ view <$> bs @@ -426,10 +425,15 @@ getPoolIds t@TestDeal{pool = pt} MultiPool pm -> Map.keys pm ResecDeal pm -> Map.keys pm _ -> error "failed to match pool type in pool ids" - -getBondByName :: Ast.Asset a => TestDeal a -> BondName -> Maybe L.Bond -getBondByName t bName = Map.lookup bName (bonds t) +-- ^ to handle with bond group, with flag to good deep if it is a bond group +getBondByName :: Ast.Asset a => TestDeal a -> Bool -> BondName -> Maybe L.Bond +getBondByName t False bName = Map.lookup bName (bonds t) +getBondByName t True bName = + let + bnds = viewDealAllBonds t + in + find (\b -> L.bndName b == bName) bnds -- ^ get issuance pool stat from pool map getIssuanceStats :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Map.Map CutoffFields Balance) diff --git a/src/Deal/DealDate.hs b/src/Deal/DealDate.hs index f8fa70d2..7104b4fd 100644 --- a/src/Deal/DealDate.hs +++ b/src/Deal/DealDate.hs @@ -21,9 +21,13 @@ instance DealDates DateDesp where (sd,dp,ed) = _m Map.! ClosingDate in sd - + getClosingDate (CustomDates _ _ cd _) = cd + getClosingDate (GenericDates m) = case Map.lookup ClosingDate m of + Just (SingletonDate x) -> x + Nothing -> error "ClosingDate not found in GenericDates" + getClosingDate (FixInterval _m _p1 _p2) = _m Map.! ClosingDate getClosingDate (PreClosingDates _ x _ _ _ _) = x @@ -45,3 +49,7 @@ instance DealDates DateDesp where getFirstPayDate (PreClosingDates _ _ _ _ _ (fp,_)) = fp getFirstPayDate (CurrentDates _ _ _ _ (cpay,_)) = cpay + + getFirstPayDate (GenericDates m) = case Map.lookup FirstPayDate m of + Just (SingletonDate x) -> x + Nothing -> error "FirstPayDate not found in GenericDates" diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index 77ae2a73..20ec4366 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -37,6 +37,7 @@ import Util import Errors import DateUtil import Control.Lens hiding (element) +import Control.Lens.Extras (is) import Control.Lens.TH import Control.Applicative import Data.Map.Lens @@ -176,8 +177,8 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f CapWith s cap -> min (queryCompound t d s) (queryCompound t d cap) Abs s -> abs <$> queryCompound t d s Round ds rb -> do - q <- queryCompound t d ds - return $ roundingBy rb q + q <- queryCompound t d ds + return $ roundingBy rb q DivideRatio s1 s2 -> queryCompound t d (Divide s1 s2) AvgRatio ss -> queryCompound t d (Avg ss) Constant v -> Right v @@ -198,14 +199,9 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f BondRate bn -> case Map.lookup bn (bonds t) of - Just b@(L.Bond {}) -> Right . toRational $ L.bndRate b - Just b@(L.BondGroup bSubMap) -> - let - bnds = Map.elems bSubMap - rates = toRational . L.bndRate <$> bnds - bals = L.getCurBalance <$> bnds - in - Right $ weightedBy bals rates + Just b@(L.Bond {}) -> Right . toRational $ L.getCurRate b + Just b@(L.MultiIntBond {}) -> Right . toRational $ L.getCurRate b + Just b@(L.BondGroup bSubMap) -> Right . toRational $ L.getCurRate b Nothing -> case viewDealBondsByNames t [bn] of [b] -> Right $ toRational $ L.bndRate b @@ -215,13 +211,22 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f rs <- sequenceA $ (\bn -> queryCompound t d (BondRate bn)) <$> bns ws <- sequenceA $ (\bn -> queryCompound t d (CurrentBondBalanceOf [bn])) <$> bns return $ weightedBy (fromRational <$> ws) rs - PoolWaRate mPns -> + + PoolWaRate Nothing -> let - latestCfs = filter isJust $ Map.elems $ getLatestCollectFrame t mPns - rates = toRational . maybe 0.0 CF.mflowRate <$> latestCfs + latestCfs = filter isJust $ Map.elems $ getLatestCollectFrame t Nothing + rates = toRational . maybe 0.0 CF.mflowRate <$> latestCfs bals = maybe 0.0 CF.mflowBalance <$> latestCfs in - Right $ weightedBy bals rates + Right $ weightedBy (toRational <$> bals) rates + + PoolWaRate (Just pName) -> + let + latestCfs = filter isJust $ Map.elems $ getLatestCollectFrame t (Just [pName]) + rates = toRational . maybe 0.0 CF.mflowRate <$> latestCfs + in + Right $ sum rates + -- int query FutureCurrentPoolBorrowerNum _d mPns -> @@ -242,7 +247,6 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f case mm of Nothing -> Left $ "Date:"++show d++"There is maturity date for bond " ++ bn Just md -> Right . toRational $ T.cdMonths $ T.diffGregorianDurationClip md d - ProjCollectPeriodNum -> Right . toRational $ maximum' $ Map.elems $ Map.map (maybe 0 CF.sizeCashFlowFrame) $ getAllCollectedFrame t Nothing @@ -274,7 +278,10 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f OriginalBondBalanceOf bnds -> Right . toRational $ sum $ getOriginBalance <$> viewDealBondsByNames t bnds CurrentBondBalanceOf bns -> Right . toRational $ sum $ getCurBalance <$> viewDealBondsByNames t bns - + + BondTotalFunding bnds -> + Right . toRational $ sum $ L.totalFundedBalance <$> viewDealBondsByNames t bnds + CurrentPoolBalance mPns -> let assetM = concat $ Map.elems $ getAllAsset t mPns @@ -300,8 +307,9 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f Nothing -> Left $ "Date:"++show d++"No issuance balance found in the pool, pls specify it in the pool stats map `issuanceStat`" UnderlyingBondBalance mBndNames -> Left $ "Date:"++show d++"Not implemented for underlying bond balance" - - AllAccBalance -> Right . toRational $ sum $ map A.accBalance $ Map.elems accMap + + AllAccBalance -> + Right . toRational $ sum $ map A.accBalance $ Map.elems accMap AccBalance ans -> do @@ -326,7 +334,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f let ldgL = Map.elems lgdsM let bs Credit = filter (\x -> LD.ledgBalance x < 0) ldgL let bs Debit = filter (\x -> LD.ledgBalance x >= 0) ldgL - return $ toRational $ abs $ sum $ LD.ledgBalance <$> bs dr -- `debug` ("dr"++show dr++">> bs dr"++ show (bs dr)) + return $ toRational $ abs $ sum $ LD.ledgBalance <$> bs dr FutureCurrentPoolBalance mPns -> case (mPns,pt) of @@ -558,19 +566,36 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f fSubMap = getFeeByName t (Just fns) stmts = map F.feeStmt $ Map.elems fSubMap ex s = case s of - Nothing -> 0 - Just (Statement txns) -> sum $ getTxnAmt <$> filter (\x -> d == getDate x) txns + Nothing -> 0 + Just (Statement txns) -> sum $ getTxnAmt <$> filter (\x -> d == getDate x) txns in Right . toRational $ sum $ map ex stmts CurrentDueBondInt bns -> - Right . toRational $ sum $ L.bndDueInt <$> viewDealBondsByNames t bns + Right . toRational $ sum $ L.getDueInt <$> viewDealBondsByNames t bns + + CurrentDueBondIntAt idx bns -> + let + bs = filter (is L._MultiIntBond) $ viewDealBondsByNames t bns + dueInts = (\x -> x!!idx) <$> (L.bndDueInts <$> bs) + in + Right . toRational $ sum dueInts CurrentDueBondIntOverInt bns -> - Right . toRational $ sum $ L.bndDueIntOverInt <$> viewDealBondsByNames t bns + Right . toRational $ sum $ L.getDueIntOverInt <$> viewDealBondsByNames t bns + + CurrentDueBondIntOverIntAt idx bns -> + let + bs = filter (is L._MultiIntBond) $ viewDealBondsByNames t bns + dueInts = (\x -> x!!idx) <$> (L.bndDueIntOverInts <$> bs) + in + Right . toRational $ sum $ dueInts CurrentDueBondIntTotal bns -> sum <$> sequenceA (queryCompound t d <$> [CurrentDueBondInt bns,CurrentDueBondIntOverInt bns]) + + CurrentDueBondIntTotalAt idx bns -> + sum <$> sequenceA (queryCompound t d <$> [CurrentDueBondIntAt idx bns,CurrentDueBondIntOverIntAt idx bns]) CurrentDueFee fns -> do @@ -605,7 +630,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f WeightedAvgCurrentBondBalance d1 d2 bns -> Right . toRational $ - Map.foldr (\v a-> a + (L.weightAverageBalance d1 d2 v)) -- `debug` (" Avg Bal for bond"++ show (L.weightAverageBalance d1 d2 v)) ) + Map.foldr (\v a-> a + (L.weightAverageBalance d1 d2 v)) 0.0 (getBondsByName t (Just bns)) @@ -628,10 +653,32 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f WeightedAvgOriginalPoolBalance d1 d2 mPns -> Right . toRational $ - mulBR + mulBR (Map.findWithDefault 0.0 IssuanceBalance (getIssuanceStatsConsol t mPns)) (yearCountFraction DC_ACT_365F d1 d2) + -- Analytics query + AmountRequiredForTargetIRR irr bondName -> + case getBondByName t True bondName of + Nothing -> Left $ "Failed to find bond by name"++ bondName + Just bnd -> + let + (ds,vs) = L.bondCashflow bnd + valid _vs = case (and ((>0) <$> vs)) of + True -> Left $ "all cashflows are positive"++ show vs + _ -> Right _vs + oDate = L.originDate $ L.bndOriginInfo bnd + in + do + validVs <- valid vs + case A.calcRequiredAmtForIrrAtDate irr ds vs d of + Nothing -> Left $ "Failed to get the required amount for target IRR: "++ bondName++" Rate:"++ show irr + Just amt -> Right $ + if oDate <= d then + (toRational amt) + else + 0.0 + CustomData s d -> case custom t of Nothing -> Left $ "Date:"++show d++"No Custom data to query" ++ show s diff --git a/src/Deal/DealValidation.hs b/src/Deal/DealValidation.hs index e1182d2a..ef06062e 100644 --- a/src/Deal/DealValidation.hs +++ b/src/Deal/DealValidation.hs @@ -463,10 +463,6 @@ validatePreRun t@TestDeal{waterfall=waterfallM issuanceBalCheck _ = [] -- val on deal status and deal dates - statusCheck (PreClosing _) PreClosingDates {} = [] - statusCheck (PreClosing _) _ = [ErrorMsg "Deal is in PreClosing status but it is not using preClosing dates"] - statusCheck _ _ = [] - -- collection rule check aggRuleResult = if isResec t then @@ -482,7 +478,7 @@ validatePreRun t@TestDeal{waterfall=waterfallM -- run result scan - allErrors = (concat errors) ++ issuanceBalCheck dates ++ aggRuleResult ++ statusCheck status dates + allErrors = (concat errors) ++ issuanceBalCheck dates ++ aggRuleResult -- check issuance balance w1 = if (not (isPreClosing t)) && (length (Map.elems (getIssuanceStats t Nothing))) == 0 then diff --git a/src/Expense.hs b/src/Expense.hs index 240cd939..e922ce0f 100644 --- a/src/Expense.hs +++ b/src/Expense.hs @@ -39,7 +39,7 @@ data FeeType = AnnualRateFee DealStats FormulaRate -- ^ an | RecurFee DatePattern Balance -- ^ fee occur every date pattern | NumFee DatePattern DealStats Amount -- ^ fee based on an integer number | AmtByTbl DatePattern DealStats (Table Balance Balance) -- ^ lookup query value in a table - | TargetBalanceFee DealStats DealStats -- ^ fee occur if (ds1 > ds2) + | TargetBalanceFee DealStats DealStats -- ^ fee due amount = max( 0, (ds1 - ds2)) | FeeFlow Ts -- ^ a time series based fee | ByCollectPeriod Amount -- ^ fix amount per collection period deriving (Show,Eq, Generic,Ord) @@ -65,9 +65,9 @@ payFee d amt f@(Fee fn ft fs fd fdDay fa flpd fstmt) = ,feeArrears = arrearRemain ,feeStmt = newStmt} where - [(r0,arrearRemain),(r1,dueRemain)] = paySeqLiabilities amt [fa,fd] -- `debug` ("AMT"++show amt++">> fa"++show fa++"fd"++show fd) - paid = fa + fd - arrearRemain - dueRemain -- `debug` ("arrear remain "++show arrearRemain++"due remain "++ show dueRemain++"r0 r1"++show r0++show r1) - newStmt = appendStmt fstmt (ExpTxn d dueRemain paid arrearRemain (PayFee fn)) -- `debug` ("Actual paid to fee"++show paid) + [(r0,arrearRemain),(r1,dueRemain)] = paySeqLiabilities amt [fa,fd] + paid = fa + fd - arrearRemain - dueRemain + newStmt = appendStmt (ExpTxn d dueRemain paid arrearRemain (PayFee fn)) fstmt -- | pay amount of fee regardless the due amount payResidualFee :: Date -> Amount -> Fee -> Fee @@ -78,7 +78,7 @@ payResidualFee d amt f@(Fee fn ft fs fd fdDay fa flpd fstmt) = ,feeStmt = newStmt} where [(r0,arrearRemain),(r1,dueRemain)] = paySeqLiabilities amt [fa,fd] - newStmt = appendStmt fstmt (ExpTxn d dueRemain amt arrearRemain (PayFee fn)) + newStmt = appendStmt (ExpTxn d dueRemain amt arrearRemain (PayFee fn)) fstmt -- | build accure dates for a fee buildFeeAccrueAction :: [Fee] -> Date -> [(String,Dates)] -> [(String,Dates)] diff --git a/src/Hedge.hs b/src/Hedge.hs index 1438dee0..4ddabef1 100644 --- a/src/Hedge.hs +++ b/src/Hedge.hs @@ -28,10 +28,9 @@ import DateUtil import qualified Assumptions as A import qualified InterestRate as IR -import Control.Lens hiding (Index) +import Control.Lens import Debug.Trace -import InterestRate (calcInt) debug = flip trace type SettleDates = DatePattern -- ^ dates when rates/ex-rates are reseted @@ -46,23 +45,28 @@ data RateSwapBase = Fixed Balance -- ^ a fixed balance as notional base 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(Show,Generic,Eq,Ord) data RateSwap = RateSwap {rsType :: RateSwapType -- ^ swap type - ,rsSettleDates :: SettleDates -- ^ define settle dates - ,rsNotional :: RateSwapBase -- ^ define notional balance - ,rsStartDate :: StartDate -- ^ swap start date - ,rsPayingRate :: IRate -- ^ collect rate - ,rsReceivingRate :: IRate -- ^ paying rate - ,rsRefBalance :: Balance -- ^ notional balance in use - ,rsLastStlDate :: Maybe Date -- ^ last settle date - ,rsNetCash :: Balance -- ^ amount to pay/collect - ,rsStmt :: Maybe Statement -- ^ transaction history - } - deriving(Show,Generic,Eq,Ord) - --- updateRefBalance :: Balance -> RateSwap -> RateSwap --- updateRefBalance bal rs = rs { rsRefBalance = bal} + ,rsDayCount :: DayCount -- ^ day count convention + ,rsSettleDates :: Maybe (SettleDates,String) -- ^ define settle dates + ,rsUpdateDates :: DatePattern -- ^ define observe dates + + ,rsNotional :: RateSwapBase -- ^ define notional balance + ,rsRefBalance :: Balance -- ^ notional balance in use + + ,rsPayingRate :: IRate -- ^ collect rate + ,rsReceivingRate :: IRate -- ^ paying rate + + ,rsNetCash :: Balance -- ^ amount to pay/collect + + ,rsStartDate :: StartDate -- ^ swap start date + ,rsLastStlDate :: Maybe Date -- ^ last settle date + ,rsStmt :: Maybe Statement -- ^ transaction history + } + deriving(Show,Generic,Eq,Ord) -- | The `accrueIRS` will calculate the `Net` amount -- ( payble with negative, positve with receivable) of Rate Swap @@ -70,37 +74,35 @@ accrueIRS :: Date -> RateSwap -> RateSwap accrueIRS d rs@RateSwap{rsRefBalance = face , rsPayingRate = payRate , rsReceivingRate = receiveRate - , rsNetCash = netCash + , rsNetCash = netCash + , rsDayCount = dc , rsStmt = stmt} - = rs {rsNetCash = newNet , rsLastStlDate = Just d, rsStmt = newStmt } + = rs {rsNetCash = newNet , rsLastStlDate = Just d, rsStmt = appendStmt newTxn stmt} where - accureStartDate = case rsLastStlDate rs of - Nothing -> rsStartDate rs - Just lsd -> lsd + accureStartDate = case rsLastStlDate rs of + Nothing -> rsStartDate rs + Just lsd -> lsd rateDiff = receiveRate - payRate - yearFactor = fromRational $ yearCountFraction DC_ACT_365F accureStartDate d + yearFactor = fromRational $ yearCountFraction dc accureStartDate d newNetAmount = mulBIR (face * yearFactor) rateDiff -- `debug` ("Diff rate"++ show rateDiff) newNet = netCash + newNetAmount newTxn = IrsTxn d face newNetAmount payRate receiveRate newNet SwapAccrue - newStmt = appendStmt stmt newTxn -- | set rate swap to state of receive all cash from counterparty receiveIRS :: Date -> RateSwap -> RateSwap receiveIRS d rs@RateSwap{rsNetCash = receiveAmt, rsStmt = stmt} - | receiveAmt > 0 = rs { rsNetCash = 0 ,rsStmt = newStmt} + | receiveAmt > 0 = rs { rsNetCash = 0 ,rsStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 (SwapInSettle "")) stmt} | otherwise = rs - where - newStmt = appendStmt stmt (IrsTxn d 0 receiveAmt 0 0 0 SwapInSettle) -- | set rate swap to state of payout all possible cash to counterparty payoutIRS :: Date -> Amount -> RateSwap -> RateSwap payoutIRS d amt rs@RateSwap{rsNetCash = payoutAmt, rsStmt = stmt} | payoutAmt < 0 = rs { rsNetCash = outstanding, rsStmt = newStmt } | otherwise = rs - where - actualAmt = min amt (negate payoutAmt) --TODO need to add a check here - outstanding = payoutAmt + actualAmt - newStmt = appendStmt stmt $ IrsTxn d 0 actualAmt 0 0 0 SwapOutSettle + where + actualAmt = min amt (negate payoutAmt) --TODO need to add a check here + outstanding = payoutAmt + actualAmt + newStmt = appendStmt (IrsTxn d 0 actualAmt 0 0 0 (SwapOutSettle "")) stmt instance QueryByComment RateSwap where queryStmt RateSwap{rsStmt = Nothing} tc = [] @@ -113,7 +115,7 @@ instance Liable RateSwap where | otherwise = False data RateCap = RateCap { - rcIndex :: Index + rcIndex :: Types.Index ,rcStrikeRate :: Ts ,rcNotional :: RateSwapBase ,rcStartDate :: Date @@ -129,10 +131,8 @@ data RateCap = RateCap { receiveRC :: Date -> RateCap -> RateCap receiveRC d rc@RateCap{rcNetCash = receiveAmt, rcStmt = stmt} - | receiveAmt > 0 = rc { rcNetCash = 0 ,rcStmt = newStmt} + | receiveAmt > 0 = rc { rcNetCash = 0 ,rcStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 (SwapInSettle "")) stmt} | otherwise = rc - where - newStmt = appendStmt stmt (IrsTxn d 0 receiveAmt 0 0 0 SwapInSettle) instance IR.UseRate RateCap where getIndexes rc@RateCap{rcIndex = idx} = Just [idx] @@ -221,10 +221,4 @@ buildSrtResetAction (srt:srts) ed r = -$(concat <$> traverse (deriveJSON defaultOptions) [''RateSwap, ''RateCap, ''RateSwapType, ''RateSwapBase, ''CurrencySwap]) - --- $(deriveJSON defaultOptions ''RateSwap) --- $(deriveJSON defaultOptions ''RateCap) --- $(deriveJSON defaultOptions ''RateSwapType) --- $(deriveJSON defaultOptions ''RateSwapBase) --- $(deriveJSON defaultOptions ''CurrencySwap) \ No newline at end of file +$(concat <$> traverse (deriveJSON defaultOptions) [''RateSwap, ''RateCap, ''RateSwapType, ''RateSwapBase, ''CurrencySwap]) \ No newline at end of file diff --git a/src/Ledger.hs b/src/Ledger.hs index d46452c8..ceeaa33e 100644 --- a/src/Ledger.hs +++ b/src/Ledger.hs @@ -3,7 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} module Ledger (Ledger(..),entryLog,LedgerName,queryGap,clearLedgersBySeq - ,queryDirection,entryLogByDr) + ,queryDirection,entryLogByDr,bookToTarget) where import qualified Data.Time as T import Stmt @@ -38,12 +38,12 @@ entryLog amt d cmt ledg@Ledger{ledgStmt = mStmt, ledgBalance = bal} newBal = bal - amt txn = EntryTxn d newBal amt cmt in - ledg { ledgStmt = appendStmt mStmt txn ,ledgBalance = newBal } + ledg { ledgStmt = appendStmt txn mStmt,ledgBalance = newBal } | otherwise = let newBal = bal + amt txn = EntryTxn d newBal amt cmt in - ledg { ledgStmt = appendStmt mStmt txn ,ledgBalance = newBal } + ledg { ledgStmt = appendStmt txn mStmt ,ledgBalance = newBal } -- TODO-- need to ensure there is no direction in input entryLogByDr :: BookDirection -> Amount -> Date -> Maybe TxnComment -> Ledger -> Ledger @@ -56,13 +56,11 @@ entryLogByDr dr amt d (Just cmt) entryLogByDr Credit amt d (Just (TxnComments cms)) = entryLog amt d (TxnComments ((TxnDirection Credit):cms)) entryLogByDr Debit amt d (Just (TxnComments cms)) = entryLog amt d (TxnComments ((TxnDirection Debit):cms)) - hasTxnDirection :: TxnComment -> Bool hasTxnDirection (TxnDirection _) = True hasTxnDirection (TxnComments txns) = any (hasTxnDirection) txns hasTxnDirection _ = False - isTxnDirection :: BookDirection -> TxnComment -> Bool isTxnDirection Credit (TxnDirection Credit) = True isTxnDirection Debit (TxnDirection Debit) = True @@ -76,6 +74,25 @@ queryDirection (Ledger _ bal _) | bal >= 0 = (Debit, bal) | bal < 0 = (Credit, negate bal) +bookToTarget :: Ledger -> (BookDirection,Amount) -> (BookDirection,Amount) +bookToTarget Ledger{ledgBalance = bal} (dr, targetBal) + = case (bal > 0, dr) of + (True, Debit) -> + if (targetBal > bal) then + (Debit,targetBal - bal) + else + (Credit,bal - targetBal) + (False, Credit) -> + if (targetBal > abs bal) then + (Credit,targetBal - abs bal) + else + (Debit, abs bal - targetBal) + (True, Credit) -> + (Credit,targetBal + bal) + (False, Debit) -> + (Debit,targetBal + abs bal) + + -- ^ return ledger's bookable amount (for netting off to zero ) with direction input queryGap :: BookDirection -> Ledger -> Balance queryGap dr Ledger{ledgBalance = bal} @@ -107,4 +124,4 @@ instance QueryByComment Ledger where makeLensesFor [("ledgName","ledgNameLens"),("ledgBalance","ledgBalLens"),("ledgStmt","ledgStmtLens")] ''Ledger -$(deriveJSON defaultOptions ''Ledger) +$(deriveJSON defaultOptions ''Ledger) \ No newline at end of file diff --git a/src/Liability.hs b/src/Liability.hs index 2821a5fc..d169d5cf 100644 --- a/src/Liability.hs +++ b/src/Liability.hs @@ -9,11 +9,18 @@ module Liability (Bond(..),BondType(..),OriginalInfo(..) ,payInt,payPrin,consolStmt,backoutDueIntByYield,isPaidOff,getCurBalance ,priceBond,PriceResult(..),pv,InterestInfo(..),RateReset(..) - ,weightAverageBalance,calcZspread,payYield,scaleBond,totalDueInt + ,getDueInt + ,weightAverageBalance,calcZspread,payYield,getTotalDueInt ,buildRateResetDates,isAdjustble,StepUp(..),isStepUp,getDayCountFromInfo ,calcWalBond,patchBondFactor,fundWith,writeOff,InterestOverInterestType(..) ,getCurBalance,setBondOrigDate,isFloaterBond - ,bndOriginInfoLens,bndIntLens,getBeginRate,_Bond,_BondGroup) + ,bndOriginInfoLens,bndIntLens,getBeginRate,_Bond,_BondGroup + ,totalFundedBalance,getIndexFromInfo,buildStepUpDates + ,accrueInt,stepUpInterestInfo,payIntByIndex,_MultiIntBond + ,getDueIntAt,getDueIntOverIntAt,getDueIntOverInt,getTotalDueIntAt + ,getCurRate + ,bondCashflow + ) where import Language.Haskell.TH @@ -22,20 +29,21 @@ import Data.Aeson.TH import Data.Fixed import qualified Data.Time as T -import Lib (Period(..),Ts(..) ,TsPoint(..) - , toDate, daysBetween, getIntervalFactors, daysBetweenI) +import Lib (Period(..),Ts(..) ,TsPoint(..) ,daysBetween, weightedBy,paySeqLiabResi) import Util import DateUtil -import Types hiding (BondGroup) +import Types import Analytics import Data.Ratio import Data.Maybe +import Data.List +import qualified Data.Set as Set + import qualified Stmt as S -import Data.List (findIndex,zip6,find) import qualified Cashflow as CF import qualified InterestRate as IR import qualified Lib @@ -47,11 +55,8 @@ import Debug.Trace import InterestRate (UseRate(getIndexes)) import Control.Lens hiding (Index) import Control.Lens.TH -import Language.Haskell.TH.Lens (_BytesPrimL) +import Language.Haskell.TH.Lens import Stmt (getTxnAmt) -import Data.Char (GeneralCategory(NotAssigned)) -import qualified Stmt as L --- import Deal.DealBase (UnderlyingDeal(futureCf)) debug = flip trace @@ -94,13 +99,13 @@ getDayCountFromInfo (WithIoI info _) = getDayCountFromInfo info getDayCountFromInfo _ = Nothing type RateReset = DatePattern -type PlannedAmorSchedule = Ts data InterestOverInterestType = OverCurrRateBy Rational -- ^ inflat ioi rate by pct over current rate - | OverFixSpread Spread -- ^ inflat ioi rate by fix spread - deriving (Show, Eq, Generic, Ord, Read) + | OverFixSpread Spread -- ^ inflat ioi rate by fix spread + deriving (Show, Eq, Generic, Ord, Read) +-- ^ the way how interest due amount is calculated --------------------------- start Rate, index, spread, reset dates, daycount, floor, cap data InterestInfo = Floater IRate Index Spread RateReset DayCount (Maybe Floor) (Maybe Cap) | Fix IRate DayCount -- ^ fixed rate @@ -111,6 +116,30 @@ data InterestInfo = Floater IRate Index Spread RateReset DayCount (Maybe Floor) | WithIoI InterestInfo InterestOverInterestType -- ^ Interest Over Interest(normal on left,IoI on right) deriving (Show, Eq, Generic, Ord, Read) + +-- data StepUp = PassDateSpread Date Spread -- ^ add a spread on a date and effective afterwards +-- | PassDateLadderSpread Date Spread RateReset -- ^ add a spread on the date pattern +stepUpInterestInfo :: StepUp -> InterestInfo -> InterestInfo +stepUpInterestInfo sp ii = + case ii of + (Floater a idx s dp dc f c) -> Floater a idx (s+getSpread sp) dp dc f c + (Fix r dc) -> Fix (r+getSpread sp) dc + (CapRate ii' r) -> CapRate (stepUpInterestInfo sp ii') r + (FloorRate ii' r) -> FloorRate (stepUpInterestInfo sp ii') r + (WithIoI ii' ooi) -> WithIoI (stepUpInterestInfo sp ii') ooi + _ -> ii + where + getSpread (PassDateSpread _ s) = s + getSpread (PassDateLadderSpread _ s _) = s + +getDpFromIntInfo :: InterestInfo -> Maybe DatePattern +getDpFromIntInfo (Floater _ _ _ dp _ _ _) = Just dp +getDpFromIntInfo (RefRate _ _ _ dp) = Just dp +getDpFromIntInfo (CapRate ii _) = getDpFromIntInfo ii +getDpFromIntInfo (FloorRate ii _) = getDpFromIntInfo ii +getDpFromIntInfo (WithIoI ii _) = getDpFromIntInfo ii +getDpFromIntInfo _ = Nothing + getBeginRate :: InterestInfo -> IRate getBeginRate (Floater a _ _ _ _ _ _ ) = a getBeginRate (Fix a _ ) = a @@ -131,6 +160,9 @@ data OriginalInfo = OriginalInfo { ,maturityDate :: Maybe Date -- ^ optional maturity date } deriving (Show, Eq, Generic, Ord, Read) + +type PlannedAmorSchedule = Ts +-- ^ the way of principal due is calculated data BondType = Sequential -- ^ Pass through type tranche | PAC PlannedAmorSchedule -- ^ bond with schedule amortization | PacAnchor PlannedAmorSchedule [BondName] -- ^ pay till schdule balance if bonds from bond names has oustanding balance, if other bonds are paid off ,then pay oustanding balance @@ -139,6 +171,10 @@ data BondType = Sequential -- ^ Pass through typ | Equity -- ^ Equity type tranche deriving (Show, Eq, Generic, Ord, Read) + +-- TODO: for multi int bond, should origin rate be a list of rates? +-- : sofar remain orginate rate as a single rate for multi int bond + data Bond = Bond { bndName :: String ,bndType :: BondType -- ^ bond type ,which describe the how principal due was calculated @@ -156,49 +192,75 @@ data Bond = Bond { ,bndLastPrinPay :: Maybe Date -- ^ last principal pay date ,bndStmt :: Maybe S.Statement -- ^ transaction history } + | MultiIntBond { + bndName :: String + ,bndType :: BondType -- ^ bond type ,which describe the how principal due was calculated + ,bndOriginInfo :: OriginalInfo -- ^ fact data on origination + ,bndInterestInfos :: [InterestInfo] -- ^ interest info which used to update interest rate + ,bndStepUps :: Maybe [StepUp] -- ^ step up which update interest rate + -- status + ,bndBalance :: Balance -- ^ current balance + ,bndRates :: [IRate] -- ^ current rate + ,bndDuePrin :: Balance -- ^ principal due for current period + ,bndDueInts :: [Balance] -- ^ interest due + ,bndDueIntOverInts :: [Balance] -- ^ IoI + ,bndDueIntDates :: Maybe [Date] -- ^ last interest due calc date + ,bndLastIntPays :: Maybe [Date] -- ^ last interest pay date + ,bndLastPrinPay :: Maybe Date -- ^ last principal pay date + ,bndStmt :: Maybe S.Statement -- ^ transaction history + } | BondGroup (Map.Map String Bond) -- ^ bond group deriving (Show, Eq, Generic, Ord, Read) + + +bndTxns :: Lens' Bond (Maybe S.Statement) +bndTxns = lens getter setter + where + getter Bond{bndStmt = mStmt} = mStmt + getter MultiIntBond{bndStmt = mStmt} = mStmt + setter Bond{bndStmt = _} mStmt = Bond{bndStmt = mStmt} + setter MultiIntBond{bndStmt = _} mStmt = MultiIntBond{bndStmt = mStmt} + +bondCashflow :: Bond -> ([Date], [Amount]) +bondCashflow b = + let t = (S.getAllTxns b) + in + (S.getDate <$> t, S.getTxnAmt <$> t) + +-- ^ remove empty transaction frgetBondByName :: Ast.Assetom a bond consolStmt :: Bond -> Bond -consolStmt (BondGroup bMap) = BondGroup $ Map.map consolStmt bMap -consolStmt b@Bond{bndName = bn, bndStmt = Nothing} = b -consolStmt b@Bond{bndName = bn, bndStmt = Just (S.Statement [])} = b -consolStmt b@Bond{bndName = bn, bndStmt = Just (S.Statement (txn:txns))} - = let - combinedBondTxns = foldl S.consolTxn [txn] txns - droppedTxns = dropWhile S.isEmptyTxn combinedBondTxns - in - b {bndStmt = Just (S.Statement (reverse droppedTxns))} +consolStmt (BondGroup bMap) = BondGroup $ consolStmt <$> bMap +consolStmt b + | S.hasEmptyTxn b = b + | otherwise = let + txn:txns = S.getAllTxns b + combinedBondTxns = foldl S.consolTxn [txn] txns + droppedTxns = dropWhile S.isEmptyTxn combinedBondTxns + in + b {bndStmt = Just (S.Statement (reverse droppedTxns))} setBondOrigDate :: Date -> Bond -> Bond setBondOrigDate d b@Bond{bndOriginInfo = oi} = b {bndOriginInfo = oi{originDate = d}} -setBondOrigDate d (BondGroup bMap) = BondGroup $ Map.map (setBondOrigDate d) bMap +setBondOrigDate d b@MultiIntBond{bndOriginInfo = oi} = b {bndOriginInfo = oi{originDate = d}} +setBondOrigDate d (BondGroup bMap) = BondGroup $ (setBondOrigDate d) <$> bMap --- | build bond factors +-- ^ build bond factors patchBondFactor :: Bond -> Bond -patchBondFactor (BondGroup bMap) = BondGroup $ Map.map patchBondFactor bMap -patchBondFactor b@Bond{bndOriginInfo = bo, bndStmt = Nothing} = b -patchBondFactor b@Bond{bndOriginInfo = bo, bndStmt = Just (S.Statement txns) } - | originBalance bo == 0 = b +patchBondFactor (BondGroup bMap) = BondGroup $ patchBondFactor <$> bMap +patchBondFactor bnd + | (S.hasEmptyTxn bnd) = bnd + | (originBalance (bndOriginInfo bnd)) == 0 = bnd | otherwise = let - oBal = originBalance bo + oBal = originBalance (bndOriginInfo bnd) toFactor (BondTxn d b i p r0 c e f Nothing t) = (BondTxn d b i p r0 c e f (Just (fromRational (divideBB b oBal))) t) - newStmt = S.Statement $ toFactor <$> txns + newStmt = S.Statement $ toFactor <$> (S.getAllTxns bnd) in - b {bndStmt = Just newStmt} + bnd {bndStmt = Just newStmt} payInt :: Date -> Amount -> Bond -> Bond -- pay 0 interest, do nothing -payInt d 0 bnd@(Bond bn bt oi iinfo _ 0 r 0 0 dueIoI dueIntDate lpayInt lpayPrin stmt) = bnd - --- pay interest to equity tranche with interest -payInt d amt bnd@(Bond bn Equity oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) - = bnd { bndDueInt = newDue, bndStmt = newStmt, bndDueIntOverInt = newDueIoI, bndLastIntPay = Just d} - where - rs = Lib.paySeqLiabilitiesAmt amt [dueIoI,dueInt] - newDueIoI = dueIoI - head rs - newDue = dueInt - rs !! 1 - newStmt = S.appendStmt stmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayYield bn)) +payInt d 0 b = b -- pay interest payInt d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) @@ -207,115 +269,163 @@ payInt d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate l rs = Lib.paySeqLiabilitiesAmt amt [dueIoI, dueInt] -- `debug` ("date"++ show d++"due "++show dueIoI++">>"++show dueInt) newDueIoI = dueIoI - head rs newDue = dueInt - rs !! 1 -- `debug` ("Avail fund"++ show amt ++" int paid out plan"++ show rs) - newStmt = S.appendStmt stmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayInt [bn])) -- `debug` ("date after"++ show d++"due "++show newDueIoI++">>"++show newDue) - -payIntBySeq :: Date -> Amount -> [Bond] -> [Bond] -> ([Bond],Amount) -payIntBySeq d amt bondsPaid [] = (bondsPaid, amt) -payIntBySeq d 0 bondsPaid bondsToPaid = (bondsPaid ++ bondsToPaid, 0) -payIntBySeq d amt bondsPaid (b:bondsToPaid) - = let - intD = getDueInt b - actPaidOut = min amt intD - remains = amt - actPaidOut + newStmt = case bt of + Equity -> S.appendStmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayYield bn)) stmt + _ -> S.appendStmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayInt [bn])) stmt -- `debug` ("date after"++ show d++"due "++show newDueIoI++">>"++show newDue) + +-- pay multi-int bond ,IOI first and then interest due, sequentially +payInt d amt bnd@(MultiIntBond bn bt oi iinfo _ bal rs duePrin dueInts dueIoIs dueIntDate lpayInt lpayPrin stmt) + = bnd {bndDueInts=newDues, bndStmt=newStmt + , bndLastIntPays = Just (replicate l d), bndDueIntOverInts = newDueIoIs} + where + l = length iinfo + ioiPaid = Lib.paySeqLiabilitiesAmt amt dueIoIs + afterIoI = amt - sum ioiPaid + duePaid = Lib.paySeqLiabilitiesAmt afterIoI dueInts + newDueIoIs = zipWith (-) dueIoIs ioiPaid + newDues = zipWith (-) dueInts duePaid + newDueIoI = sum newDueIoIs + newDue = sum newDues + newStmt = case bt of + Equity -> S.appendStmt (BondTxn d bal amt 0 (sum rs) amt newDue newDueIoI Nothing (S.PayYield bn)) stmt + _ -> S.appendStmt (BondTxn d bal amt 0 (sum rs) amt newDue newDueIoI Nothing (S.PayInt [bn])) stmt -- `debug` ("date after"++ show d++"due "++show newDueIoI++">>"++show newDue) + +payIntByIndex :: Date -> Int -> Amount -> Bond -> Bond +-- pay 0 interest, do nothing +payIntByIndex d _ 0 b = b +payIntByIndex d idx amt bnd@(MultiIntBond bn bt oi iinfo _ bal rs duePrin dueInts dueIoIs dueIntDate lpayInt lpayPrin stmt) + = let + dueIoI = dueIoIs !! idx + dueInt = dueInts !! idx -- `debug` ("date"++ show d++"in pay index fun"++ show amt) + [newDueIoI,newDue] = Lib.paySeqLiabResi amt [dueIoI, dueInt] -- `debug` ("date"++ show d++" before pay due "++show dueIoI++">>"++show dueInt) + newStmt = S.appendStmt (BondTxn d bal amt 0 (sum rs) amt newDue newDueIoI Nothing (S.PayInt [bn])) stmt -- `debug` ("date after"++ show d++"due(ioi) "++show newDueIoI++">> due "++show newDue) + od = getOriginDate bnd + ods = replicate (length iinfo) od in - payIntBySeq d remains (payInt d actPaidOut b:bondsPaid) bondsToPaid + bnd {bndDueInts = dueInts & ix idx .~ newDue + ,bndDueIntOverInts = dueIoIs & ix idx .~ newDueIoI + ,bndStmt = newStmt + ,bndLastIntPays = case lpayInt of + Nothing -> Just $ ods & ix idx .~ d + Just ds -> Just $ ds & ix idx .~ d} +-- ^ pay interest to single bond regardless any interest due payYield :: Date -> Amount -> Bond -> Bond payYield d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) - = bnd {bndStmt= newStmt} + = bnd {bndDueInt = newDue,bndDueIntOverInt=newDueIoI, bndStmt= newStmt} where - newStmt = S.appendStmt stmt (BondTxn d bal amt 0 r amt dueInt dueIoI Nothing (S.PayYield bn)) + [newDue,newDueIoI] = paySeqLiabResi amt [dueIoI, dueInt] + newStmt = S.appendStmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayYield bn)) stmt + +-- ^ pay principal to single bond principal with limit of principal due payPrin :: Date -> Amount -> Bond -> Bond -payPrin d 0 bnd@(Bond bn bt oi iinfo _ 0 r 0 0 dueIoI dueIntDate lpayInt lpayPrin stmt) = bnd +-- ^ no cash payment , do nothing +payPrin d 0 bnd = bnd +-- ^ no oustanding balance , do nothing payPrin d _ bnd@(Bond bn bt oi iinfo _ 0 r 0 0 dueIoI dueIntDate lpayInt lpayPrin stmt) = bnd -payPrin d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) - = bnd {bndDuePrin =newDue, bndBalance = newBal , bndStmt=newStmt} -- `debug` ("after pay prin:"++ show d ++">"++ show bn++"due"++show newDue++"bal"++ show newBal ) + +payPrin d amt bnd = bnd {bndDuePrin =newDue, bndBalance = newBal , bndStmt=newStmt} where - newBal = bal - amt - newDue = duePrin - amt - newStmt = S.appendStmt stmt (BondTxn d newBal 0 amt r amt dueInt dueIoI Nothing (S.PayPrin [bn] )) + newBal = (bndBalance bnd) - amt + newDue = (bndDuePrin bnd) - amt + bn = bndName bnd + stmt = bndStmt bnd + dueIoI = getDueIntOverInt bnd + dueInt = getDueInt bnd + r = getCurRate bnd + newStmt = S.appendStmt (BondTxn d newBal 0 amt r amt dueInt dueIoI Nothing (S.PayPrin [bn] )) stmt writeOff :: Date -> Amount -> Bond -> Bond -writeOff d 0 b = b -- `debug` ("Zero on wirte off") -writeOff d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) - = bnd {bndBalance = newBal , bndStmt=newStmt} - where - newBal = bal - amt - newStmt = S.appendStmt stmt (BondTxn d newBal 0 0 0 0 dueInt dueIoI Nothing (S.WriteOff bn amt )) +writeOff d 0 b = b +writeOff d amt bnd = bnd {bndBalance = newBal , bndStmt=newStmt} + where + newBal = (bndBalance bnd) - amt + dueIoI = getDueIntOverInt bnd + dueInt = getDueInt bnd + bn = bndName bnd + stmt = bndStmt bnd + newStmt = S.appendStmt (BondTxn d newBal 0 0 0 0 dueInt dueIoI Nothing (S.WriteOff bn amt )) stmt fundWith :: Date -> Amount -> Bond -> Bond fundWith d 0 b = b -fundWith d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) - = bnd {bndBalance = newBal - , bndStmt=newStmt - } +fundWith d amt bnd + = bnd {bndBalance = newBal, bndStmt=newStmt } where - newBal = bal + amt - newStmt = S.appendStmt stmt (BondTxn d newBal 0 (negate amt) 0 0 dueInt dueIoI Nothing (S.FundWith bn amt )) + dueIoI = getDueIntOverInt bnd + dueInt = getDueInt bnd + bn = bndName bnd + stmt = bndStmt bnd + newBal = (bndBalance bnd) - amt + newStmt = S.appendStmt (BondTxn d newBal 0 (negate amt) 0 0 dueInt dueIoI Nothing (S.FundWith bn amt )) stmt -priceBond :: Date -> Ts -> Bond -> PriceResult -priceBond d rc b@(Bond bn _ (OriginalInfo obal od _ _) iinfo _ bal cr _ _ _ _ lastIntPayDay _ (Just (S.Statement txns))) - | sum (S.getTxnAmt <$> futureCfs) == 0 = PriceResult 0 0 0 0 0 0 [] - | otherwise = - let - presentValue = foldr (\x acc -> acc + pv rc d (S.getDate x) (S.getTxnAmt x)) 0 futureCfs -- `debug` "PRICING -A" - cutoffBalance = case S.getTxnAsOf txns d of - Nothing -> (S.getTxnBegBalance . head) txns - Just _txn -> S.getTxnBegBalance _txn - accruedInt = case _t of - Nothing -> max 0 $ IR.calcInt leftBal leftPayDay d cr dcToUse - Just _ -> 0 - where - dcToUse = fromMaybe DC_ACT_365F $ getDayCountFromInfo iinfo - _t = find (\x -> S.getDate x == d) txns - leftTxns = cutBy Exc Past d txns - (leftPayDay,leftBal) = case leftTxns of - [] -> case lastIntPayDay of - Nothing -> (od,bal) - Just _d -> (_d,bal) - _ -> let - leftTxn = last leftTxns - in - (S.getDate leftTxn,S.getTxnBalance leftTxn) - wal = calcWalBond d b - duration = let - ps = zip futureCfDates futureCfFlow - in - calcDuration d ps rc - convexity = let - b = (foldr (\x acc -> - let - _t = yearCountFraction DC_ACT_365F d (S.getDate x) -- `debug` ("calc _T"++show d++">>"++show (S.getTxnDate x)) - _t2 = _t * _t + _t -- `debug` ("T->"++show _t) - _cash_date = S.getDate x - _yield = getValByDate rc Exc _cash_date - _y = (1+ _yield) * (1+ _yield) -- `debug` ("yield->"++ show _yield++"By date"++show d) - _x = ((mulBR (pv rc d _cash_date (S.getTxnAmt x)) _t2) / (fromRational _y)) -- `debug` ("PRICING -E") -- `debug` ("PV:->"++show (pv rc d (S.getTxnDate x) (S.getTxnAmt x))++"Y->"++ show _y++"T2-->"++ show _t2) - in - _x + acc) - 0 - futureCfs) -- `debug` ("PRICING VALUE"++ show presentValue) - in - b/presentValue -- `debug` "PRICING -D" -- `debug` ("B->"++show b++"PV"++show presentValue) +-- TODO: add how to handle different rate for IOI +getIoI :: InterestInfo -> IRate -> IRate +getIoI (WithIoI _ (OverCurrRateBy r)) rate = rate * (1+ fromRational r) +getIoI (WithIoI _ (OverFixSpread r)) rate = rate + r +getIoI _ rate = rate + + +accrueInt :: Date -> Bond -> Bond +accrueInt d b@Bond{bndInterestInfo = ii,bndDueIntDate = mDueIntDate, bndDueInt= dueInt + , bndDueIntOverInt = dueIoI, bndRate = r, bndBalance = bal} + | d == beginDate = b + | otherwise = let + period = yearCountFraction (((fromMaybe DC_ACT_365F) . getDayCountFromInfo) ii) beginDate d + r2 = getIoI ii r + newDue = mulBR bal $ toRational r * period + newIoiDue = mulBR dueInt (toRational r2 * period) in - -- PriceResult presentValue (fromRational (100*(toRational presentValue)/(toRational obal))) (realToFrac wal) (realToFrac duration) (realToFrac convexity) accruedInt futureCfs-- `debug` ("Obal->"++ show obal++"Rate>>"++ show (bndRate b)) - PriceResult presentValue (fromRational (100* (safeDivide' presentValue obal))) (realToFrac wal) (realToFrac duration) (realToFrac convexity) accruedInt futureCfs-- `debug` ("Obal->"++ show obal++"Rate>>"++ show (bndRate b)) - where - futureCfs = cutBy Exc Future d txns - futureCfDates = getDate <$> futureCfs - futureCfFlow = getTxnAmt <$> futureCfs + b {bndDueInt = newDue+dueInt, bndDueIntOverInt = dueIoI+newIoiDue + ,bndDueIntDate = Just d} + where + beginDate = case mDueIntDate of + Just _d -> _d + Nothing -> getOriginDate b + + +-- TODO: HOW to accrue a single index ? +accrueInt d b@MultiIntBond{bndInterestInfos = iis, bndDueIntDates = mDueIntDates + , bndDueInts = dueInts, bndDueIntOverInts = dueIoIs + , bndRates = rs, bndBalance = bal} + | all (==d) beginDates = b + | otherwise + = let + l = length iis -- `debug` ("bond Name>>> "++ show (bndName b)) + daycounts = (fromMaybe DC_ACT_365F) . getDayCountFromInfo <$> iis + beginDates = case mDueIntDates of + Just ds -> ds + Nothing -> getOriginDate b <$ [1..l] + periods = zipWith3 yearCountFraction daycounts beginDates (repeat d) -- `debug` ((bndName b) ++" date"++ show d++"daycounts"++show daycounts++"beginDates "++show beginDates++ show "end dates"++ show d) + newDues = zipWith3 (\r p due -> (mulBR (mulBIR bal r) p) + due) rs periods dueInts -- `debug` ((bndName b) ++" date"++ show d++"rs"++show rs++"periods "++show periods++">>"++show dueInts) + newIoiDues = zipWith5 (\r p due dueIoI ii -> + (mulBR (mulBIR due (getIoI ii r)) p) + dueIoI) + rs + periods + dueInts + dueIoIs + iis + in + b {bndDueInts = newDues, bndDueIntOverInts = newIoiDues, bndDueIntDates = Just (replicate l d) } + where + l = length iis + beginDates = case mDueIntDates of + Just ds -> ds + Nothing -> (getOriginDate b) <$ [1..l] +accrueInt d (BondGroup bMap) = BondGroup $ accrueInt d <$> bMap -priceBond d rc b@(Bond _ _ _ _ _ _ _ _ _ _ _ _ _ Nothing ) = PriceResult 0 0 0 0 0 0 [] + +-- ^ TODO WAL for bond group calcWalBond :: Date -> Bond -> Rational calcWalBond d b@Bond{bndStmt = Nothing} = 0.0 -calcWalBond d b@Bond{bndStmt = Just (S.Statement _txns)} - = let - txns = cutBy Exc Future d _txns +calcWalBond d b@MultiIntBond{bndStmt = Nothing} = 0.0 +calcWalBond d b + = let + txns = cutBy Exc Future d $ S.getAllTxns b cutoffBalance = (S.getTxnBegBalance . head ) txns lastBalance = (S.getTxnBalance . last) txns firstTxnDate = d @@ -329,30 +439,84 @@ calcWalBond d b@Bond{bndStmt = Just (S.Statement _txns)} toRational wal -- `debug` ("WAL-->"++show (bndName b)++">>"++show wal) +getTxnRate :: Txn -> IRate +getTxnRate (BondTxn _ _ _ _ r _ _ _ _ _) = r +getTxnRate _ = 0.0 + +-- ^TODO to be tested +calcAccrueInt :: Date -> Bond -> Balance +calcAccrueInt d bnd@(BondGroup bMap) = sum $ calcAccrueInt d <$> Map.elems bMap +calcAccrueInt d bnd@(Bond {bndStmt = mstmt, bndRate = r, bndBalance = bal}) + | isNothing mstmt = IR.calcInt bal (getOriginDate bnd) d r DC_ACT_365F + | d <= getOriginDate bnd = 0 + | isJust mstmt = + let + txns = S.getAllTxns bnd + ds = S.getDate <$> txns + in + case (S.getTxnAsOf txns d, elem d ds) of + (_ , True) -> 0 + (Nothing,_) -> IR.calcInt bal (getOriginDate bnd) d r DC_ACT_365F -- `debug` (">>> "++ show (getOriginDate bnd) ++ ">>> "++ show d++"bal"++show bal++"rate"++show r++"r"++ show ( IR.calcInt bal (getOriginDate bnd) d r DC_ACT_365F)++ ">>\n txns"++ show txns) + (Just txn,_) -> IR.calcInt (S.getTxnBalance txn) (S.getDate txn) d r DC_ACT_365F -- `debug` ("Accrue Int"++show d++">>"++show (S.getDate txn)++ ">>"++show (S.getTxnBalance txn)++"Rate"++show r) + +calcAccrueInt d bnd@(MultiIntBond {bndStmt = mstmt, bndRates = rs, bndBalance = bal}) + | isNothing mstmt = IR.calcInt bal (getOriginDate bnd) d (sum rs) DC_ACT_365F + | d <= getOriginDate bnd = 0 + | isJust mstmt = + let + txns = S.getAllTxns bnd + ds = S.getDate <$> txns + in + case (S.getTxnAsOf txns d, elem d ds) of + (_, True) -> 0 + (Nothing,_) -> IR.calcInt bal (getOriginDate bnd) d (sum rs) DC_ACT_365F + (Just txn,_) -> IR.calcInt (S.getTxnBalance txn) (S.getDate txn) d (getTxnRate txn) DC_ACT_365F + + +priceBond :: Date -> Ts -> Bond -> PriceResult +priceBond d rc b@(Bond _ _ _ _ _ _ _ _ _ _ _ _ _ Nothing ) = PriceResult 0 0 0 0 0 0 [] +priceBond d rc b@(MultiIntBond _ _ _ _ _ _ _ _ _ _ _ _ _ Nothing ) = PriceResult 0 0 0 0 0 0 [] +priceBond d rc bnd + | sum (S.getTxnAmt <$> futureCfs) == 0 = PriceResult 0 0 0 0 0 0 [] + | otherwise + = let + presentValue = foldr (\x acc -> acc + pv rc d (S.getDate x) (S.getTxnAmt x)) 0 futureCfs -- `debug` "PRICING -A" + cutoffBalance = case S.getTxnAsOf txns d of + Nothing -> (S.getTxnBegBalance . head) txns + Just _txn -> S.getTxnBegBalance _txn + accruedInt = calcAccrueInt d bnd + wal = calcWalBond d bnd + duration = calcDuration d (zip futureCfDates futureCfFlow) rc + convexity = let + b = (foldr (\x acc -> + let + _t = yearCountFraction DC_ACT_365F d (S.getDate x) -- `debug` ("calc _T"++show d++">>"++show (S.getTxnDate x)) + _t2 = _t * _t + _t -- `debug` ("T->"++show _t) + _cash_date = S.getDate x + _yield = getValByDate rc Exc _cash_date + _y = (1+ _yield) * (1+ _yield) -- `debug` ("yield->"++ show _yield++"By date"++show d) + _x = ((mulBR (pv rc d _cash_date (S.getTxnAmt x)) _t2) / (fromRational _y)) -- `debug` ("PRICING -E") -- `debug` ("PV:->"++show (pv rc d (S.getTxnDate x) (S.getTxnAmt x))++"Y->"++ show _y++"T2-->"++ show _t2) + in + _x + acc) + 0 + futureCfs) -- `debug` ("PRICING VALUE"++ show presentValue) + in + b/presentValue -- `debug` "PRICING -D" -- `debug` ("B->"++show b++"PV"++show presentValue) + in + PriceResult presentValue (fromRational (100* (safeDivide' presentValue obal))) (realToFrac wal) (realToFrac duration) (realToFrac convexity) accruedInt futureCfs-- `debug` ("Obal->"++ show obal++"Rate>>"++ show (bndRate b)) + where + cr = getCurRate bnd + bal = getCurBalance bnd + txns = S.getAllTxns bnd + futureCfs = cutBy Exc Future d txns + futureCfDates = getDate <$> futureCfs + futureCfFlow = getTxnAmt <$> futureCfs + obal = getOriginBalance bnd + od = getOriginDate bnd -_calcIRR :: Balance -> IRR -> Date -> Ts -> IRR -_calcIRR amt initIrr today (BalanceCurve cashflows) - = if ((abs(diff) < 0.005) || (abs(nextIrr-initIrr)<0.0001)) then - initIrr - else - _calcIRR amt nextIrr today (BalanceCurve cashflows) -- `debug` ("NextIRR -> "++show(nextIrr)) - where - discount (TsPoint _d _a) _r = (toRational _a) / ((1+_r)^(div (fromIntegral (T.diffDays _d today)) 365)) - pv = foldr (\_ts acc -> (discount _ts initIrr) + acc) 0 cashflows -- `debug` ("") - diff = pv - (toRational amt) -- `debug` ("pv->"++show(pv)) - nextIrr = if diff > 0 then - initIrr * 1.01 - else - initIrr * 0.99 - -calcBondYield :: Date -> Balance -> Bond -> Rate -calcBondYield _ _ (Bond _ _ _ _ _ _ _ _ _ _ _ _ _ Nothing) = 0 -calcBondYield d cost b@(Bond _ _ _ _ _ _ _ _ _ _ _ _ _ (Just (S.Statement txns))) - = _calcIRR cost 0.05 d (BalanceCurve cashflows) - where - cashflows = [ TsPoint (S.getDate txn) (S.getTxnAmt txn) | txn <- txns ] -- ^ backout interest due for a Yield Maintainace type bond +-- ^ TODO: need to handle MuitIntBond here backoutDueIntByYield :: Date -> Bond -> Balance backoutDueIntByYield d b@(Bond _ _ (OriginalInfo obal odate _ _) (InterestByYield y) _ currentBalance _ _ _ _ _ _ _ stmt) = projFv - fvs - currentBalance -- `debug` ("Date"++ show d ++"FV->"++show projFv++">>"++show fvs++">>cb"++show currentBalance) @@ -363,25 +527,38 @@ backoutDueIntByYield d b@(Bond _ _ (OriginalInfo obal odate _ _) (InterestByYiel Just (S.Statement txns) -> [ ((S.getDate txn),(S.getTxnAmt txn)) | txn <- txns ] -- `debug` (show d ++":TXNS"++ show txns) Nothing -> [] - --- weightAverageBalance :: Date -> Date -> Bond -> Balance + +weightAverageBalance :: Date -> Date -> Bond -> Balance weightAverageBalance sd ed b@(Bond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ Nothing) = mulBR currentBalance (yearCountFraction DC_ACT_365F (max bd sd) ed) +weightAverageBalance sd ed b@(MultiIntBond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ Nothing) + = mulBR currentBalance (yearCountFraction DC_ACT_365F (max bd sd) ed) + weightAverageBalance sd ed b@(Bond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ (Just stmt)) - = L.weightAvgBalance' - (max bd sd) - ed - (view S.statementTxns stmt) + = S.weightAvgBalance' + (max bd sd) + ed + (view S.statementTxns stmt) + +weightAverageBalance sd ed b@(MultiIntBond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ (Just stmt)) + = S.weightAvgBalance' + (max bd sd) + ed + (view S.statementTxns stmt) + weightAverageBalance sd ed bg@(BondGroup bMap) = sum $ weightAverageBalance sd ed <$> Map.elems bMap -- `debug` (">>>"++ show (weightAverageBalance sd ed <$> Map.elems bMap)) calcZspread :: (Rational,Date) -> Int -> (Float, (Rational,Rational),Rational) -> Bond -> Ts -> Spread calcZspread _ _ _ b@Bond{bndStmt = Nothing} _ = error "No Cashflow for bond" -calcZspread (tradePrice,priceDay) count (level ,(lastSpd,lastSpd2),spd) b@Bond{bndStmt = Just (S.Statement txns), bndOriginInfo = bInfo} riskFreeCurve +calcZspread _ _ _ b@MultiIntBond{bndStmt = Nothing} _ = error "No Cashflow for bond" +calcZspread (tradePrice,priceDay) count (level ,(lastSpd,lastSpd2),spd) b riskFreeCurve | count >= 10000 = fromRational spd -- error "Failed to find Z spread with 10000 times try" | otherwise = let + txns = S.getAllTxns b + bInfo = bndOriginInfo b (_,futureTxns) = splitByDate txns priceDay EqToRight cashflow = S.getTxnAmt <$> futureTxns @@ -419,97 +596,176 @@ calcZspread (tradePrice,priceDay) count (level ,(lastSpd,lastSpd2),spd) b@Bond{b else calcZspread (tradePrice,priceDay) (succ count) (newLevel, (spd, lastSpd), newSpd) b riskFreeCurve -- `debug` ("new price"++ show pricingFaceVal++"trade price"++ show tradePrice++ "new spd"++ show (fromRational newSpd)) -totalDueInt :: Bond -> Balance -totalDueInt Bond{bndDueInt = a,bndDueIntOverInt = b } = a + b -totalDueInt (BondGroup bMap) = sum $ totalDueInt <$> Map.elems bMap + +totalFundedBalance :: Bond -> Balance +totalFundedBalance (BondGroup bMap) = sum $ totalFundedBalance <$> Map.elems bMap +totalFundedBalance b + = let + txns = S.getAllTxns b + isFundingTxn (FundWith _ _) = True + isFundingTxn _ = False + fundingTxns = S.filterTxn isFundingTxn txns + in + sum $ (\(BondTxn d b i p r0 c di dioi f t) -> abs p) <$> fundingTxns buildRateResetDates :: Bond -> StartDate -> EndDate -> [Date] buildRateResetDates (BondGroup bMap) sd ed = concat $ (\x -> buildRateResetDates x sd ed) <$> Map.elems bMap buildRateResetDates b@Bond{bndInterestInfo = ii,bndStepUp = mSt } sd ed - = let - floaterRateResetDates = case ii of - (Floater _ _ _ dp _ _ _) -> genSerialDatesTill2 NO_IE sd dp ed -- `debug` ("building rest2"++show (bndName b )++"dp"++show dp++"ed"++show ed++"sd"++show sd ) - (CapRate ii _) -> buildRateResetDates b {bndInterestInfo = ii} sd ed - (FloorRate ii _) -> buildRateResetDates b {bndInterestInfo = ii} sd ed - (RefRate _ _ _ dp) -> genSerialDatesTill2 NO_IE sd dp ed - x -> [] -- `debug` ("fall out"++ show x) - stepUpDates = case mSt of - Nothing -> [] - Just (PassDateSpread d _) -> [d] - Just (PassDateLadderSpread fstSd _ dp) -> genSerialDatesTill2 IE fstSd dp ed + = let + resetDp = getDpFromIntInfo ii + floaterRateResetDates (Just dp) = genSerialDatesTill2 NO_IE sd dp ed + floaterRateResetDates Nothing = [] in - floaterRateResetDates ++ stepUpDates -- `debug` ("building rest1"++show floaterRateResetDates++"bname"++ show (bndName b )) - - - + floaterRateResetDates resetDp -scaleBond :: Rate -> Bond -> Bond -scaleBond r (BondGroup bMap) = BondGroup $ Map.map (scaleBond r) bMap -scaleBond r b@Bond{ bndOriginInfo = oi, bndInterestInfo = iinfo, bndStmt = mstmt - , bndBalance = bal, bndDuePrin = dp, bndDueInt = di, bndDueIntDate = did - , bndLastIntPay = lip, bndLastPrinPay = lpp - , bndType = bt} - = b { - bndType = scaleBndType r bt - ,bndOriginInfo = scaleBndOriginInfo r oi - ,bndBalance = mulBR bal r - ,bndDuePrin = mulBR dp r - ,bndDueInt = mulBR di r - ,bndStmt = scaleStmt r mstmt - } - where - scaleBndType r (PAC ts) = let - vs = (flip mulBR r . fromRational <$> getTsVals ts) - ds = getTsDates ts - in - PAC $ BalanceCurve [ TsPoint d v | (d,v) <- zip ds vs] - scaleBndType r _bt = _bt - - scaleBndOriginInfo r oi@OriginalInfo{originBalance = ob} = oi {originBalance = mulBR ob r} - - scaleStmt r Nothing = Nothing - scaleStmt r (Just (S.Statement txns)) = Just (S.Statement (S.scaleTxn r <$> txns)) +buildRateResetDates b@MultiIntBond{bndInterestInfos = iis} sd ed + = let + floaterRateResetDates (Just dp) = genSerialDatesTill2 NO_IE sd dp ed + floaterRateResetDates Nothing = [] + in + -- TODO: perf: sort and distinct + concat $ (floaterRateResetDates . getDpFromIntInfo) <$> iis + + + +buildStepUpDates :: Bond -> StartDate -> EndDate -> [Date] +buildStepUpDates (BondGroup bMap) sd ed = concat $ (\x -> buildStepUpDates x sd ed) <$> Map.elems bMap +buildStepUpDates b@Bond{bndStepUp = mSt } sd ed + = case mSt of + Nothing -> [] + Just (PassDateSpread d _) -> [d] + Just (PassDateLadderSpread fstSd _ dp) -> genSerialDatesTill2 IE fstSd dp ed + +buildStepUpDates b@MultiIntBond{bndStepUps = mSt } sd ed + = case mSt of + Nothing -> [] + -- TODO: perf: sort and distinct + Just sts -> Set.toList $ + Set.fromList $ + concat $ + (\y -> + case y of + (PassDateLadderSpread fstSd _ dp) -> genSerialDatesTill2 IE fstSd dp ed + (PassDateSpread d _) -> [d] + ) <$> sts + +-- buildRateResetDates b@MultiIntBond{bndInterestInfo = ii,bndStepUp = mSt } sd ed + + +-- scaleBond :: Rate -> Bond -> Bond +-- scaleBond r (BondGroup bMap) = BondGroup $ Map.map (scaleBond r) bMap +-- scaleBond r b@Bond{ bndOriginInfo = oi, bndInterestInfo = iinfo, bndStmt = mstmt +-- , bndBalance = bal, bndDuePrin = dp, bndDueInt = di, bndDueIntDate = did +-- , bndLastIntPay = lip, bndLastPrinPay = lpp +-- , bndType = bt} +-- = b { +-- bndType = scaleBndType r bt +-- ,bndOriginInfo = scaleBndOriginInfo r oi +-- ,bndBalance = mulBR bal r +-- ,bndDuePrin = mulBR dp r +-- ,bndDueInt = mulBR di r +-- ,bndStmt = scaleStmt r mstmt +-- } +-- where +-- scaleBndType r (PAC ts) = let +-- vs = (flip mulBR r . fromRational <$> getTsVals ts) +-- ds = getTsDates ts +-- in +-- PAC $ BalanceCurve [ TsPoint d v | (d,v) <- zip ds vs] +-- scaleBndType r _bt = _bt +-- scaleBndOriginInfo r oi@OriginalInfo{originBalance = ob} = oi {originBalance = mulBR ob r} +-- scaleStmt r Nothing = Nothing +-- scaleStmt r (Just (S.Statement txns)) = Just (S.Statement (S.scaleTxn r <$> txns)) instance S.QueryByComment Bond where queryStmt Bond{bndStmt = Nothing} tc = [] + queryStmt MultiIntBond{bndStmt = Nothing} tc = [] queryStmt Bond{bndStmt = Just (S.Statement txns)} tc - = filter (\x -> S.getTxnComment x == tc) txns + = Data.List.filter (\x -> S.getTxnComment x == tc) txns + queryStmt MultiIntBond{bndStmt = Just (S.Statement txns)} tc + = Data.List.filter (\x -> S.getTxnComment x == tc) txns instance Liable Bond where - isPaidOff b@Bond{bndName = bn,bndBalance=bal,bndDuePrin=dp, bndDueInt=di, bndDueIntOverInt=dioi} + + isPaidOff b@Bond{bndBalance=bal, bndDueInt=di, bndDueIntOverInt=dioi} | bal==0 && di==0 && dioi==0 = True + | otherwise = False + isPaidOff MultiIntBond{bndBalance=bal, bndDueInts=dis, bndDueIntOverInts=diois} + | bal==0 && sum dis==0 && sum diois==0 = True | otherwise = False -- `debug` (bn ++ ":bal"++show bal++"dp"++show dp++"di"++show di) - isPaidOff (BondGroup bMap) = all (==True) $ isPaidOff <$> Map.elems bMap - getCurBalance b@Bond{bndBalance=bal} = bal + getCurBalance b@Bond {bndBalance = bal } = bal + getCurBalance b@MultiIntBond {bndBalance = bal } = bal getCurBalance (BondGroup bMap) = sum $ getCurBalance <$> Map.elems bMap + + getCurRate Bond{bndRate = r} = r + getCurRate MultiIntBond{bndRates = rs} = sum rs + getCurRate (BondGroup bMap) = + fromRational $ + weightedBy + (toRational . getCurBalance <$> Map.elems bMap) + (toRational . getCurRate <$> Map.elems bMap) - getOriginBalance b@Bond{ bndOriginInfo = bo } = originBalance bo + getOriginBalance b = originBalance $ bndOriginInfo b getOriginBalance (BondGroup bMap) = sum $ getOriginBalance <$> Map.elems bMap - getDueInt b@Bond{bndDueInt=di,bndDueIntOverInt=dioi} = di + dioi + getOriginDate b = originDate $ bndOriginInfo b + + + getDueInt b@Bond{bndDueInt=di} = di + getDueInt MultiIntBond{bndDueInts=dis} = sum dis getDueInt (BondGroup bMap) = sum $ getDueInt <$> Map.elems bMap - getOutstandingAmount b = getDueInt b + getCurBalance b + getDueIntAt MultiIntBond{bndDueInts=dis} idx = dis !! idx + getDueIntOverIntAt MultiIntBond{bndDueIntOverInts=diois} idx = diois !! idx + getTotalDueIntAt b idx = getDueIntAt b idx + getDueIntOverIntAt b idx + + getDueIntOverInt b@Bond{bndDueIntOverInt=dioi} = dioi + getDueIntOverInt MultiIntBond{bndDueIntOverInts=diois} = sum diois + getDueIntOverInt (BondGroup bMap) = sum $ getDueIntOverInt <$> Map.elems bMap + + getTotalDueInt b@Bond{bndDueInt=di,bndDueIntOverInt=dioi} = di + dioi + getTotalDueInt MultiIntBond{bndDueInts=dis,bndDueIntOverInts=diois} = sum dis + sum diois + getTotalDueInt (BondGroup bMap) = sum $ getTotalDueInt <$> Map.elems bMap + + getOutstandingAmount b = getTotalDueInt b + getCurBalance b instance IR.UseRate Bond where isAdjustbleRate :: Bond -> Bool isAdjustbleRate Bond{bndInterestInfo = iinfo} = isAdjustble iinfo -- getIndex Bond{bndInterestInfo = iinfo } getIndexes Bond{bndInterestInfo = iinfo} = getIndexFromInfo iinfo - getIndexes (BondGroup bMap) = if null combined then Nothing else Just combined + getIndexes (BondGroup bMap) = if Data.List.null combined then Nothing else Just combined where combined = concat . catMaybes $ (\b -> getIndexFromInfo (bndInterestInfo b)) <$> Map.elems bMap - + getIndexes MultiIntBond{bndInterestInfos = iis} + = Just $ concat $ concat <$> getIndexFromInfo <$> iis +-- txnsLens :: Lens' Bond [Txn] +-- txnsLens = bndStmtLens . _Just . S.statementTxns +instance S.HasStmt Bond where + + getAllTxns Bond{bndStmt = Nothing} = [] + getAllTxns Bond{bndStmt = Just (S.Statement txns)} = txns + getAllTxns MultiIntBond{bndStmt = Nothing} = [] + getAllTxns MultiIntBond{bndStmt = Just (S.Statement txns)} = txns + getAllTxns (BondGroup bMap) = concat $ S.getAllTxns <$> Map.elems bMap + + hasEmptyTxn Bond{bndStmt = Nothing} = True + hasEmptyTxn Bond{bndStmt = Just (S.Statement [])} = True + hasEmptyTxn MultiIntBond{bndStmt = Nothing} = True + hasEmptyTxn MultiIntBond{bndStmt = Just (S.Statement [])} = True + hasEmptyTxn (BondGroup bMap) = all S.hasEmptyTxn $ Map.elems bMap + hasEmptyTxn _ = False + + makeLensesFor [("bndType","bndTypeLens"),("bndOriginInfo","bndOriginInfoLens"),("bndInterestInfo","bndIntLens"),("bndStmt","bndStmtLens")] ''Bond makeLensesFor [("bndOriginDate","bndOriginDateLens"),("bndOriginBalance","bndOriginBalanceLens"),("bndOriginRate","bndOriginRateLens")] ''OriginalInfo makePrisms ''Bond - $(deriveJSON defaultOptions ''InterestOverInterestType) $(deriveJSON defaultOptions ''InterestInfo) $(deriveJSON defaultOptions ''OriginalInfo) $(deriveJSON defaultOptions ''BondType) $(deriveJSON defaultOptions ''StepUp) -$(deriveJSON defaultOptions ''Bond) +$(deriveJSON defaultOptions ''Bond) \ No newline at end of file diff --git a/src/Lib.hs b/src/Lib.hs index fa6831c3..af9686e0 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -15,7 +15,7 @@ module Lib ,paySeqLiabilitiesAmt,getIntervalDays,getIntervalFactors ,zipWith8,zipWith9,zipWith10,zipWith11,zipWith12 ,weightedBy, mkTs - ,mkRateTs + ,mkRateTs,paySeqLiabResi ) where import qualified Data.Time as T @@ -113,6 +113,12 @@ paySeqLiabilitiesAmt startAmt funds where remainBals = map snd $ paySeqLiabilities startAmt funds +paySeqLiabResi :: Amount -> [Balance] -> [Amount] +paySeqLiabResi startAmt funds + = zipWith (-) funds allocatedAmts + where + allocatedAmts = paySeqLiabilitiesAmt startAmt funds + afterNPeriod :: T.Day -> Integer -> Period -> T.Day afterNPeriod d i p = T.addGregorianMonthsClip ( months * i) d @@ -207,13 +213,12 @@ floatToFixed x = y where y = MkFixed (round (fromInteger (resolution y) * x)) -- | given balances and weight, get sum weighted balance -weightedBy :: [Centi] -> [Rational] -> Rational +weightedBy :: [Rational] -> [Rational] -> Rational weightedBy ws vs | sum_weights == 0 = 0 - | otherwise = sum ( zipWith (*) vs _ws ) / sum_weights + | otherwise = sum ( zipWith (*) vs ws ) / sum_weights where - _ws = toRational <$> ws - sum_weights = sum _ws + sum_weights = sum ws -- | Given a start date and a end date, return number of days between(Integer) daysBetween :: Date -> Date -> Integer diff --git a/src/Pool.hs b/src/Pool.hs index e3c478d8..cfc2b1ad 100644 --- a/src/Pool.hs +++ b/src/Pool.hs @@ -94,7 +94,6 @@ getIssuanceField :: Pool a -> CutoffFields -> Balance getIssuanceField p@Pool{issuanceStat = Just m} s = case Map.lookup s m of Just r -> r - -- Nothing -> error ("Failed to lookup "++show s++" in stats "++show m) Nothing -> 0.0 getIssuanceField Pool{issuanceStat = Nothing} _ = error "There is no pool stats" diff --git a/src/Reports.hs b/src/Reports.hs index a00f8f09..ba0822a6 100644 --- a/src/Reports.hs +++ b/src/Reports.hs @@ -77,18 +77,6 @@ getPoolBalanceStats t d mPid poolStats2::[Rational] <- sequenceA poolStats return $ fromRational <$> poolStats2 --- getPoolBalanceStats t d Nothing --- = sequenceA --- (queryCompound t d (FutureCurrentPoolBalance Nothing) --- ,(queryCompound t d (PoolCumCollection [NewDefaults] Nothing)) --- ,negate (queryCompound t (PoolCumCollection [CollectedRecoveries] Nothing))) --- --- getPoolBalanceStats t d (Just pid) = --- sequenceA --- (queryCompound t d (FutureCurrentPoolBalance (Just [pid])) --- ,(queryCompound t d (PoolCumCollection [NewDefaults] (Just [pid]))) --- ,negate (queryCompound t d (PoolCumCollection [CollectedRecoveries] (Just [pid])))) - @@ -137,7 +125,7 @@ buildBalanceSheet t@TestDeal{ pool = pool, bonds = bndMap , fees = feeMap , liqP let feeToPay = ParentItem "Fee" [ ParentItem feeName [Item "Due" feeDueBal] | (feeName,feeDueBal) <- Map.toList feeWithDueAmount ] bndWithDueAmount <- mapM (calcDueInt t d Nothing Nothing) bndMap - let bndToShow = Map.map (\bnd -> (L.getCurBalance bnd, L.totalDueInt bnd)) bndWithDueAmount + let bndToShow = Map.map (\bnd -> (L.getCurBalance bnd, L.getTotalDueInt bnd)) bndWithDueAmount let bndM = [ ParentItem bndName [Item "Balance" bndBal,Item "Due Int" bndDueAmt ] | (bndName,(bndBal,bndDueAmt)) <- Map.toList bndToShow] let liab = ParentItem "Liability" [ ParentItem "Bond" bndM , feeToPay, ParentItem "Liquidity" liqProviderOs, swapToPay] @@ -146,6 +134,7 @@ buildBalanceSheet t@TestDeal{ pool = pool, bonds = bndMap , fees = feeMap , liqP let eqty = Item "Net Asset" (totalAssetBal - totalDebtBal) return $ BalanceSheetReport {asset=ast,liability=liab,equity=eqty,reportDate=d} +-- TODO performance improve here, need to filter txn first buildCashReport :: P.Asset a => TestDeal a -> Date -> Date -> CashflowReport buildCashReport t@TestDeal{accounts = accs} sd ed = CashflowReport { inflow = inflowItems @@ -154,7 +143,6 @@ buildCashReport t@TestDeal{accounts = accs} sd ed , startDate = sd , endDate = ed } where - -- TODO performance improve here, need to filter txn first _txns = concat $ Map.elems $ Map.map getTxns $ Map.map A.accStmt accs txns = sliceBy EI sd ed _txns diff --git a/src/Stmt.hs b/src/Stmt.hs index 9f785066..a0e880f5 100644 --- a/src/Stmt.hs +++ b/src/Stmt.hs @@ -7,11 +7,13 @@ module Stmt (Statement(..) ,getTxns,getTxnComment,getTxnAmt,toDate,getTxnPrincipal,getTxnAsOf,getTxnBalance - ,appendStmt,combineTxn,sliceStmt,getTxnBegBalance,getDate,getDates + ,appendStmt,combineTxn,getTxnBegBalance,getDate,getDates ,TxnComment(..),QueryByComment(..) ,weightAvgBalanceByDates,weightAvgBalance,weightAvgBalance',sumTxn, consolTxn ,getFlow,FlowDirection(..), aggByTxnComment,scaleByFactor - ,scaleTxn,isEmptyTxn, statementTxns, viewBalanceAsOf + ,scaleTxn,isEmptyTxn, statementTxns, viewBalanceAsOf,filterTxn + ,HasStmt(..) + ,getAllTxns,hasEmptyTxn ) where @@ -85,7 +87,6 @@ getTxnBalance (ExpTxn _ t _ _ _ ) = t getTxnBalance (SupportTxn _ _ t _ _ _ _ ) = t -- drawed balance getTxnBalance (EntryTxn _ t _ _) = t - -- | SupportTxn Date (Maybe Balance) Balance DueInt DuePremium Cash TxnComment getTxnBegBalance :: Txn -> Balance @@ -127,11 +128,6 @@ isEmptyTxn (IrsTxn _ 0 0 0 0 0 Empty) = True isEmptyTxn (EntryTxn _ 0 0 Empty) = True isEmptyTxn _ = False - -sliceStmt :: Date -> Date -> Statement -> Statement -sliceStmt sd ed (Statement txns) - = Statement $ sliceBy II sd ed txns - viewBalanceAsOf :: Date -> [Txn] -> Balance viewBalanceAsOf d [] = 0.0 viewBalanceAsOf d txns @@ -175,9 +171,9 @@ weightAvgBalance' sd ed (_txn:_txns) data Statement = Statement [Txn] deriving (Show, Generic, Eq, Ord, Read) -appendStmt :: Maybe Statement -> Txn -> Maybe Statement -appendStmt (Just stmt@(Statement txns)) txn = Just $ Statement (txns++[txn]) -appendStmt Nothing txn = Just $ Statement [txn] +appendStmt :: Txn -> Maybe Statement -> Maybe Statement +appendStmt txn (Just stmt@(Statement txns)) = Just $ Statement (txns++[txn]) +appendStmt txn Nothing = Just $ Statement [txn] statementTxns :: Lens' Statement [Txn] @@ -197,11 +193,14 @@ getTxns :: Maybe Statement -> [Txn] getTxns Nothing = [] getTxns (Just (Statement txn)) = txn --- BondTxn Date Balance Interest Principal IRate Cash DueInt DueIoI (Maybe Float) TxnComment -- ^ bond transaction record for interest and principal - combineTxn :: Txn -> Txn -> Txn combineTxn (BondTxn d1 b1 i1 p1 r1 c1 f1 g1 h1 m1) (BondTxn d2 b2 i2 p2 r2 c2 f2 g2 h2 m2) - = BondTxn d1 b2 (i1 + i2) (p1 + p2) r2 (c1+c2) f2 g2 h2 (TxnComments [m1,m2]) + = let + rateToSet (FundWith _ _) _ = r2 + rateToSet _ (FundWith _ _) = r1 + rateToSet _ _ = r2 + in + BondTxn d1 b2 (i1 + i2) (p1 + p2) (rateToSet m1 m2) (c1+c2) f2 g2 h2 (TxnComments [m1,m2]) combineTxn (SupportTxn d1 b1 b0 i1 p1 c1 m1) (SupportTxn d2 b2 b02 i2 p2 c2 m2) = SupportTxn d1 b2 b02 (i1 + i2) (p1 + p2) (c1 + c2) (TxnComments [m1,m2]) @@ -240,8 +239,8 @@ getFlow comment = Tag _ -> Noneflow UsingDS _ -> Noneflow SwapAccrue -> Noneflow - SwapInSettle -> Inflow - SwapOutSettle -> Outflow + SwapInSettle _ -> Inflow + SwapOutSettle _ -> Outflow PurchaseAsset _ _-> Outflow IssuanceProceeds _ -> Inflow TxnDirection _ -> Noneflow @@ -258,6 +257,10 @@ getFlow comment = Noneflow _ -> error ("Missing in GetFlow >> "++ show comment) + +filterTxn :: (TxnComment -> Bool) -> [Txn] -> [Txn] +filterTxn f txns = filter (\t -> f (getTxnComment t) ) txns + instance Ord Txn where compare :: Txn -> Txn -> Ordering compare (BondTxn d1 _ _ _ _ _ _ _ _ _) (BondTxn d2 _ _ _ _ _ _ _ _ _) = compare d1 d2 @@ -282,11 +285,10 @@ class QueryByComment a where queryTxnAmt a tc = sum $ map getTxnAmt $ queryStmt a tc queryTxnAmtAsOf :: a -> Date -> TxnComment -> Balance queryTxnAmtAsOf a d tc = sum $ getTxnAmt <$> queryStmtAsOf a d tc --- queryTxn :: [Txn] -> TxnComment -> [Txn] --- queryTxn txns comment = [ txn | txn <- txns, getTxnComment txn == comment] --- --- queryTxnAmt :: [Txn] -> TxnComment -> Balance --- queryTxnAmt txns comment --- = sum $ geTxnAmt <$> queryTxn txns comment + + +class HasStmt a where + getAllTxns :: a -> [Txn] + hasEmptyTxn :: a -> Bool $(deriveJSON defaultOptions ''Statement) diff --git a/src/Types.hs b/src/Types.hs index 2a90e7b1..23b46ce3 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -30,7 +30,7 @@ module Types ,PricingMethod(..),CustomDataType(..),ResultComponent(..),DealStatType(..) ,ActionWhen(..) ,getDealStatType,getPriceValue,preHasTrigger - ,MyRatio,HowToPay(..) + ,MyRatio,HowToPay(..),ApplyRange(..) ) where @@ -127,10 +127,6 @@ type AccruedInterest = Centi type IRR = Rational - -data YieldResult = Yiel - - data Index = LPR5Y | LPR1Y | LIBOR1M @@ -180,10 +176,18 @@ data DayCount = DC_30E_360 -- ^ ISMA European 30S/360 Special German Eurob deriving (Show,Eq,Generic,Ord,Read) -data DateType = ClosingDate -- ^ deal closing day - | CutoffDate -- ^ after which, the pool cashflow was aggregated to SPV - | FirstPayDate -- ^ first payment day for bond/waterfall to run with - | StatedMaturityDate -- ^ sated maturity date, all cashflow projection/deal action stops by +data DateType = ClosingDate -- ^ deal closing day + | CutoffDate -- ^ after which, the pool cashflow was aggregated to SPV + | FirstPayDate -- ^ first payment day for bond/waterfall to run with + | NextPayDate + | NextCollectDate + | FirstCollectDate -- ^ first collection day for pool + | LastCollectDate -- ^ last collection day for pool + | LastPayDate -- ^ last payment day for bond/waterfall + | StatedMaturityDate -- ^ sated maturity date, all cashflow projection/deal action stops by + | DistributionDates -- ^ distribution date for waterfall + | CollectionDates -- ^ collection date for pool + | CustomExeDates String -- ^ custom execution date deriving (Show,Ord,Eq,Generic,Read) @@ -198,6 +202,7 @@ data DatePattern = MonthEnd | DayOfMonth Int -- T.DayOfMonth | SemiAnnual (Int, Int) (Int, Int) | CustomDate [Date] + | SingletonDate Date | DaysInYear [(Int, Int)] | EveryNMonth Date Int | Weekday Int @@ -278,6 +283,12 @@ data DateDirection = Future | Past deriving (Show,Read,Generic) +data ApplyRange = ByAll + | ByIndexes [Int] + | ByKeys [String] + deriving (Show,Read,Generic) + + class TimeSeries ts where cmp :: ts -> ts -> Ordering cmp t1 t2 = compare (getDate t1) (getDate t2) @@ -386,6 +397,7 @@ data PricingMethod = BalanceFactor Rate Rate -- ^ [balance] to be multi | PV IRate Rate -- ^ discount factor, recovery pct on default | PVCurve Ts -- ^ [CF] Pricing cashflow with a Curve | PvRate IRate -- ^ [CF] Pricing cashflow with a constant rate + | PvWal Ts | PvByRef DealStats -- ^ [CF] Pricing cashflow with a ref rate | Custom Rate -- ^ custom amount deriving (Show, Eq ,Generic, Read,Ord) @@ -457,8 +469,8 @@ data TxnComment = PayInt [BondName] | Tag String | UsingDS DealStats | SwapAccrue - | SwapInSettle - | SwapOutSettle + | SwapInSettle String + | SwapOutSettle String | PurchaseAsset String Balance | IssuanceProceeds String | TxnDirection BookDirection @@ -485,6 +497,7 @@ data DealStats = CurrentBondBalance | CumulativeNetLoss (Maybe [PoolId]) | OriginalBondBalance | OriginalBondBalanceOf [BondName] + | BondTotalFunding [BondName] | OriginalPoolBalance (Maybe [PoolId]) | DealIssuanceBalance (Maybe [PoolId]) | UseCustomData String @@ -518,6 +531,7 @@ data DealStats = CurrentBondBalance | BondBalanceGap BondName | BondBalanceGapAt Date BondName | BondDuePrin [BondName] + | BondReturn BondName Balance [TsPoint Amount] | FeePaidAt Date FeeName | FeeTxnAmt [FeeName] (Maybe TxnComment) | BondTxnAmt [BondName] (Maybe TxnComment) @@ -527,8 +541,11 @@ data DealStats = CurrentBondBalance | AccTxnAmtBy Date [AccName] (Maybe TxnComment) | FeesPaidAt Date [FeeName] | CurrentDueBondInt [BondName] + | CurrentDueBondIntAt Int [BondName] | CurrentDueBondIntOverInt [BondName] + | CurrentDueBondIntOverIntAt Int [BondName] | CurrentDueBondIntTotal [BondName] + | CurrentDueBondIntTotalAt Int [BondName] | CurrentDueFee [FeeName] | LastBondIntPaid [BondName] | LastBondPrinPaid [BondName] @@ -545,6 +562,8 @@ data DealStats = CurrentBondBalance | WeightedAvgOriginalPoolBalance Date Date (Maybe [PoolId]) | WeightedAvgOriginalBondBalance Date Date [BondName] | CustomData String Date + -- analytical query + | AmountRequiredForTargetIRR Double BondName -- integer type | CurrentPoolBorrowerNum (Maybe [PoolId]) | FutureCurrentPoolBorrowerNum Date (Maybe [PoolId]) @@ -562,7 +581,7 @@ data DealStats = CurrentBondBalance | HasPassedMaturity [BondName] | TriggersStatus DealCycle String -- rate type - | PoolWaRate (Maybe [PoolId]) + | PoolWaRate (Maybe PoolId) | BondRate BondName | CumulativeNetLossRatio (Maybe [PoolId]) | FutureCurrentBondFactor Date @@ -677,6 +696,7 @@ data PriceResult = PriceResult Valuation PerFace WAL Duration Convexity AccruedI | AssetPrice Valuation WAL Duration Convexity AccruedInterest | OASResult PriceResult [Valuation] Spread | ZSpread Spread +-- | IRRbyDate Valuation deriving (Show, Eq, Generic) @@ -698,8 +718,15 @@ class Liable lb where -- must implement isPaidOff :: lb -> Bool getCurBalance :: lb -> Balance + getCurRate :: lb -> IRate getOriginBalance :: lb -> Balance + getOriginDate :: lb -> Date getDueInt :: lb -> Balance + getDueIntAt :: lb -> Int -> Balance + getDueIntOverInt :: lb -> Balance + getDueIntOverIntAt :: lb -> Int -> Balance + getTotalDueInt :: lb -> Balance + getTotalDueIntAt :: lb -> Int -> Balance getOutstandingAmount :: lb -> Balance @@ -796,6 +823,7 @@ data ActionWhen = EndOfPoolCollection -- ^ waterfall executed at the | DefaultDistribution -- ^ default waterfall executed | RampUp -- ^ ramp up | WithinTrigger String -- ^ waterfall executed within a trigger + | CustomWaterfall String -- ^ custom waterfall deriving (Show,Ord,Eq,Generic,Read) @@ -842,8 +870,8 @@ instance ToJSON TxnComment where toJSON LiquidationDraw = String $ T.pack $ "" toJSON (LiquidationRepay s) = String $ T.pack $ "" toJSON SwapAccrue = String $ T.pack $ "" - toJSON SwapInSettle = String $ T.pack $ "" - toJSON SwapOutSettle = String $ T.pack $ "" + toJSON (SwapInSettle s)= String $ T.pack $ "" + toJSON (SwapOutSettle s) = String $ T.pack $ "" toJSON (PurchaseAsset rPoolName bal) = String $ T.pack $ " rPoolName <>","++show bal++">" toJSON (TxnDirection dr) = String $ T.pack $ "" toJSON SupportDraw = String $ T.pack $ "" @@ -905,8 +933,8 @@ parseTxn t = case tagName of "Draw" -> return LiquidationDraw "Repay" -> return $ LiquidationRepay contents "Accure" -> return SwapAccrue - "SettleIn" -> return SwapInSettle - "SettleOut" -> return SwapOutSettle + "SettleIn" -> return $ SwapInSettle contents + "SettleOut" -> return $ SwapOutSettle contents "PurchaseAsset" -> let sv = T.splitOn (T.pack ",") $ T.pack contents in @@ -975,41 +1003,51 @@ data CustomDataType = CustomConstant Rational | CustomDS DealStats deriving (Show,Ord,Eq,Read,Generic) - - +opts :: JSONKeyOptions +opts = defaultJSONKeyOptions -- { keyModifier = toLower } $(deriveJSON defaultOptions ''DealStatus) $(deriveJSON defaultOptions ''CutoffType) + + +-- $(deriveJSON defaultOptions ''DateType) + $(concat <$> traverse (deriveJSON defaultOptions) [''BookDirection, ''DealStats, ''PricingMethod, ''DealCycle, ''DateType, ''Period, ''DatePattern, ''Table, ''BalanceSheetReport, ''BookItem, ''CashflowReport, ''Txn] ) - instance ToJSONKey DateType where - toJSONKey = genericToJSONKey defaultJSONKeyOptions - + toJSONKey = genericToJSONKey opts instance FromJSONKey DateType where - fromJSONKey = genericFromJSONKey defaultJSONKeyOptions + fromJSONKey = FromJSONKeyTextParser $ \t -> + case T.splitOn " " t of + ["CustomExeDates", rest] -> pure $ CustomExeDates (T.unpack rest) + _ -> case readMaybe (T.unpack t) of + Just k -> pure k + Nothing -> fail ("Invalid key (DateType): " ++ show t++">>"++ show (T.unpack t)) $(deriveJSON defaultOptions ''RangeType) $(deriveJSON defaultOptions ''Pre) - $(deriveJSON defaultOptions ''CustomDataType) + $(deriveJSON defaultOptions ''ActionWhen) instance ToJSONKey ActionWhen where toJSONKey = toJSONKeyText (T.pack . show) instance FromJSONKey ActionWhen where - fromJSONKey = FromJSONKeyTextParser $ \t -> case readMaybe (T.unpack t) of - Just k -> pure k - Nothing -> fail ("Invalid key: " ++ show t++">>"++ show (T.unpack t)) + fromJSONKey = FromJSONKeyTextParser $ \t -> + case T.splitOn " " t of + ["CustomWaterfall", rest] -> pure $ CustomWaterfall (T.unpack rest) + _ -> case readMaybe (T.unpack t) of + Just k -> pure k + Nothing -> fail ("Invalid key (Action When): " ++ show t++">>"++ show (T.unpack t)) -$(deriveJSON defaultOptions ''ResultComponent) +$(deriveJSON defaultOptions ''ResultComponent) $(deriveJSON defaultOptions ''PriceResult) $(deriveJSON defaultOptions ''CutoffFields) $(deriveJSON defaultOptions ''HowToPay) @@ -1047,10 +1085,6 @@ instance Show MyRatio where Left (sci, _) -> show $ formatScientific Fixed (Just 8) sci Right (sci, rep) -> show $ formatScientific Fixed (Just 8) sci -opts :: JSONKeyOptions -opts = defaultJSONKeyOptions -- { keyModifier = toLower } - - $(deriveJSON defaultOptions ''Index) $(deriveJSON defaultOptions ''DayCount) $(deriveJSON defaultOptions ''Threshold) diff --git a/src/Util.hs b/src/Util.hs index d07328f1..a0cc9ab4 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -14,8 +14,9 @@ module Util ,safeDivide,lstToMapByFn,paySequentially,payProRata,mapWithinMap ,payInMap,adjustM,lookupAndApply,lookupAndUpdate,lookupAndApplies ,lookupInMap,selectInMap + ,lookupTuple6 ,lookupTuple7 -- for debug - ,zyj + ,debugOnDate ) where import qualified Data.Time as T @@ -239,7 +240,7 @@ floorWith floor xs = [ max x floor | x <- xs] daysInterval :: [Date] -> [Integer] daysInterval ds = zipWith daysBetween (init ds) (tail ds) - + debugLine :: Show a => [a] -> String debugLine xs = "" @@ -375,7 +376,7 @@ payProRata d amt getDueAmt payFn tobePaidList (paidList, remainAmt) payInMap :: Date -> Amount -> (a->Balance) -> (Amount->a->a)-> [String] - -> HowToPay -> Map.Map String a -> Map.Map String a + -> HowToPay -> Map.Map String a -> Map.Map String a payInMap d amt getDueFn payFn objNames how inputMap = let objsToPay = (inputMap Map.!) <$> objNames @@ -392,17 +393,17 @@ payInMap d amt getDueFn payFn objNames how inputMap mapWithinMap :: Ord k => (a -> a) -> [k] -> Map.Map k a -> Map.Map k a mapWithinMap fn ks m = foldr (Map.adjust fn) m ks - adjustM :: (Ord k, Applicative m) => (a -> m a) -> k -> Map.Map k a -> m (Map.Map k a) adjustM f = Map.alterF (traverse f) - +-- ^ lookup and apply a function to a single value in a map ,return a value lookupAndApply :: Ord k => (a -> b) -> String -> k -> Map.Map k a -> Either String b lookupAndApply f errMsg key m = case Map.lookup key m of Nothing -> Left errMsg Just a -> Right $ f a +-- ^ lookup and apply a function to values in a map ,return a list lookupAndApplies :: Ord k => (a -> b) -> String -> [k] -> Map.Map k a -> Either String [b] lookupAndApplies f errMsg keys m = sequenceA $ (\x -> lookupAndApply f errMsg x m) <$> keys @@ -418,7 +419,6 @@ lookupAndUpdate f errMsg keys m lookupInMap :: (Show k, Ord k) => String -> [k] -> Map.Map k a -> Either String (Map.Map k a) lookupInMap = lookupAndUpdate id - selectInMap :: (Show k, Ord k) => String -> [k] -> Map.Map k a -> Either String (Map.Map k a) selectInMap errMsg keys m | S.isSubsetOf inputKs mapKs = Right $ (Map.filterWithKey (\k _ -> S.member k inputKs) m) @@ -427,11 +427,18 @@ selectInMap errMsg keys m inputKs = S.fromList keys mapKs = Map.keysSet m +lookupTuple6 :: (Ord k) => (k, k, k, k, k, k) -> Map.Map k v -> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v) +lookupTuple6 (k1, k2, k3, k4, k5, k6) m = + ( Map.lookup k1 m , Map.lookup k2 m , Map.lookup k3 m , Map.lookup k4 m , Map.lookup k5 m , Map.lookup k6 m) + +lookupTuple7 :: (Ord k) => (k, k, k, k, k, k, k) -> Map.Map k v -> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v) +lookupTuple7 (k1, k2, k3, k4, k5, k6, k7) m = + ( Map.lookup k1 m , Map.lookup k2 m , Map.lookup k3 m , Map.lookup k4 m , Map.lookup k5 m , Map.lookup k6 m, Map.lookup k7 m) + + + ----- DEBUG/PRINT --- z y j : stands for chinese Zhao Yao Jing ,which is a mirror reveals the devil -zyj :: Show a => Maybe String -> [a] -> String -zyj ms vs = - let - ss = show <$> vs - in - "|" ++ (fromMaybe "" ms) ++ "|" ++ concat (intersperse " >> " ss) ++ "|" +debugOnDate :: Date -> Date -> Date -> String +debugOnDate d1 d2 d + | (d <= d2) && (d >= d1) = "Date:"++show d + | otherwise = "" \ No newline at end of file diff --git a/src/Waterfall.hs b/src/Waterfall.hs index 321b746b..7f8f00b0 100644 --- a/src/Waterfall.hs +++ b/src/Waterfall.hs @@ -33,14 +33,14 @@ import Ledger (Ledger,LedgerName) data BookType = PDL BookDirection DealStats [(LedgerName,DealStats)] -- Reverse PDL Debit reference, [(name,cap reference)] - | ByAccountDraw LedgerName -- Book amount equal to account draw amount - | ByDS LedgerName BookDirection DealStats -- Book amount equal to a formula/deal stats + | ByDS LedgerName BookDirection DealStats -- Book amount equal to a formula/deal stats + | Till LedgerName BookDirection DealStats -- Book amount till deal stats deriving (Show,Generic,Eq,Ord) -data ExtraSupport = SupportAccount AccountName (Maybe BookType) -- ^ if there is deficit, draw another account to pay the shortfall - | SupportLiqFacility LiquidityProviderName -- ^ if there is deficit, draw facility's available credit to pay the shortfall - | MultiSupport [ExtraSupport] -- ^ if there is deficit, draw multiple supports (by sequence in the list) to pay the shortfall - | WithCondition Pre ExtraSupport -- ^ support only available if Pre is true +data ExtraSupport = SupportAccount AccountName (Maybe BookLedger) -- ^ if there is deficit, draw another account to pay the shortfall + | SupportLiqFacility LiquidityProviderName -- ^ if there is deficit, draw facility's available credit to pay the shortfall + | MultiSupport [ExtraSupport] -- ^ if there is deficit, draw multiple supports (by sequence in the list) to pay the shortfall + | WithCondition Pre ExtraSupport -- ^ support only available if Pre is true deriving (Show,Generic,Eq,Ord) data PayOrderBy = ByName @@ -69,11 +69,14 @@ data Action = | CalcBondInt [BondName] (Maybe DealStats) (Maybe DealStats) -- ^ calculate interest due amount in the bond names,with optional balance and rate | PayIntOverInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay interest over interest only | PayInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay interest with cash from the account with optional limit or extra support + | PayIntAndBook (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) BookLedger -- ^ pay interest with cash from the account with optional limit or extra support | PayIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ with sequence | PayIntOverIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay interest over interest only with sequence | AccrueAndPayInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ combination of CalcInt and PayInt | AccrueAndPayIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ with sequence | PayIntResidual (Maybe Limit) AccountName BondName -- ^ pay interest to bond regardless interest due + | PayIntByRateIndex (Maybe Limit) AccountName [BondName] Int (Maybe ExtraSupport) -- ^ pay interest to bond by index + | PayIntByRateIndexBySeq (Maybe Limit) AccountName [BondName] Int (Maybe ExtraSupport) -- ^ pay interest to bond by index -- | PayTillYield AccountName [BondName] -- Bond - Principal | CalcBondPrin (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ calculate principal due amount in the bond names @@ -105,8 +108,8 @@ data Action = | LiqRepay (Maybe Limit) CE.LiqRepayType AccountName CE.LiquidityProviderName -- ^ repay liquidity facility | LiqYield (Maybe Limit) AccountName CE.LiquidityProviderName -- ^ repay compensation to liquidity facility | LiqAccrue [CE.LiquidityProviderName] -- ^ accure premium/due interest of liquidity facility - -- Swap - | SwapAccrue CeName -- ^ calculate the net amount of swap + -- Rate Swap + | SwapAccrue CeName -- ^ calculate the net amount of swap manually | SwapReceive AccountName CeName -- ^ receive amount from net amount of swap and deposit to account | SwapPay AccountName CeName -- ^ pay out net amount from account | SwapSettle AccountName CeName -- ^ pay & receive net amount of swap with account diff --git a/swagger.json b/swagger.json index 5ef87b63..3b624fd0 100644 --- a/swagger.json +++ b/swagger.json @@ -498,6 +498,57 @@ "title": "PayInt", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Limit" + }, + { + "type": "string" + }, + { + "items": { + "type": "string" + }, + "type": "array" + }, + { + "$ref": "#/components/schemas/ExtraSupport" + }, + { + "items": [ + { + "$ref": "#/components/schemas/BookDirection" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + } + ], + "maxItems": 5, + "minItems": 5, + "type": "array" + }, + "tag": { + "enum": [ + "PayIntAndBook" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "PayIntAndBook", + "type": "object" + }, { "properties": { "contents": { @@ -682,6 +733,92 @@ "title": "PayIntResidual", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Limit" + }, + { + "type": "string" + }, + { + "items": { + "type": "string" + }, + "type": "array" + }, + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + }, + { + "$ref": "#/components/schemas/ExtraSupport" + } + ], + "maxItems": 5, + "minItems": 5, + "type": "array" + }, + "tag": { + "enum": [ + "PayIntByRateIndex" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "PayIntByRateIndex", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Limit" + }, + { + "type": "string" + }, + { + "items": { + "type": "string" + }, + "type": "array" + }, + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + }, + { + "$ref": "#/components/schemas/ExtraSupport" + } + ], + "maxItems": 5, + "minItems": 5, + "type": "array" + }, + "tag": { + "enum": [ + "PayIntByRateIndexBySeq" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "PayIntByRateIndexBySeq", + "type": "object" + }, { "properties": { "contents": { @@ -2165,7 +2302,36 @@ }, "tag": { "enum": [ - "ResetIRSwapRate" + "CalcIRSwap" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "CalcIRSwap", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "SettleIRSwap" ], "type": "string" } @@ -2174,7 +2340,7 @@ "tag", "contents" ], - "title": "ResetIRSwapRate", + "title": "SettleIRSwap", "type": "object" }, { @@ -2235,6 +2401,35 @@ "title": "ResetBondRate", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "StepUpBondRate" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "StepUpBondRate", + "type": "object" + }, { "properties": { "contents": { @@ -2399,6 +2594,45 @@ "title": "IssueBond", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "$ref": "#/components/schemas/Pre" + }, + { + "type": "string" + }, + { + "type": "string" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 5, + "minItems": 5, + "type": "array" + }, + "tag": { + "enum": [ + "FundBond" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "FundBond", + "type": "object" + }, { "properties": { "contents": { @@ -2668,6 +2902,25 @@ ], "title": "WithinTrigger", "type": "object" + }, + { + "properties": { + "contents": { + "type": "string" + }, + "tag": { + "enum": [ + "CustomWaterfall" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "CustomWaterfall", + "type": "object" } ] }, @@ -4084,18 +4337,110 @@ }, { "properties": { - "contents": { - "additionalProperties": { - "$ref": "#/components/schemas/Bond" + "bndBalance": { + "multipleOf": 1.0e-2, + "type": "number" + }, + "bndDueIntDates": { + "items": { + "$ref": "#/components/schemas/Day" }, - "type": "object" + "type": "array" }, - "tag": { - "enum": [ - "BondGroup" - ], - "type": "string" - } + "bndDueIntOverInts": { + "items": { + "multipleOf": 1.0e-2, + "type": "number" + }, + "type": "array" + }, + "bndDueInts": { + "items": { + "multipleOf": 1.0e-2, + "type": "number" + }, + "type": "array" + }, + "bndDuePrin": { + "multipleOf": 1.0e-2, + "type": "number" + }, + "bndInterestInfos": { + "items": { + "$ref": "#/components/schemas/InterestInfo" + }, + "type": "array" + }, + "bndLastIntPays": { + "items": { + "$ref": "#/components/schemas/Day" + }, + "type": "array" + }, + "bndLastPrinPay": { + "$ref": "#/components/schemas/Day" + }, + "bndName": { + "type": "string" + }, + "bndOriginInfo": { + "$ref": "#/components/schemas/OriginalInfo" + }, + "bndRates": { + "items": { + "multipleOf": 1.0e-6, + "type": "number" + }, + "type": "array" + }, + "bndStepUps": { + "items": { + "$ref": "#/components/schemas/StepUp" + }, + "type": "array" + }, + "bndStmt": { + "$ref": "#/components/schemas/Statement" + }, + "bndType": { + "$ref": "#/components/schemas/BondType" + }, + "tag": { + "enum": [ + "MultiIntBond" + ], + "type": "string" + } + }, + "required": [ + "bndName", + "bndType", + "bndOriginInfo", + "bndInterestInfos", + "bndBalance", + "bndRates", + "bndDuePrin", + "bndDueInts", + "bndDueIntOverInts", + "tag" + ], + "title": "MultiIntBond", + "type": "object" + }, + { + "properties": { + "contents": { + "additionalProperties": { + "$ref": "#/components/schemas/Bond" + }, + "type": "object" + }, + "tag": { + "enum": [ + "BondGroup" + ], + "type": "string" + } }, "required": [ "tag", @@ -4188,33 +4533,17 @@ "$ref": "#/components/schemas/Day" }, { - "type": "string" - }, - { - "multipleOf": 1.0e-2, + "format": "double", "type": "number" - }, - { - "items": { - "multipleOf": 1.0e-6, - "type": "number" - }, - "type": "array" - }, - { - "additionalProperties": { - "$ref": "#/components/schemas/Ts" - }, - "type": "object" } ], - "maxItems": 5, - "minItems": 5, + "maxItems": 2, + "minItems": 2, "type": "array" }, "tag": { "enum": [ - "OASInput" + "DiscountRate" ], "type": "string" } @@ -4223,7 +4552,56 @@ "tag", "contents" ], - "title": "OASInput", + "title": "DiscountRate", + "type": "object" + }, + { + "properties": { + "contents": { + "additionalProperties": { + "items": [ + { + "$ref": "#/components/schemas/Ts" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "items": [ + { + "items": { + "$ref": "#/components/schemas/Day" + }, + "type": "array" + }, + { + "$ref": "#/components/schemas/PricingMethod" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + "type": "object" + }, + "tag": { + "enum": [ + "IRRInput" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "IRRInput", "type": "object" } ] @@ -4470,11 +4848,24 @@ { "properties": { "contents": { - "type": "string" + "items": [ + { + "type": "string" + }, + { + "$ref": "#/components/schemas/BookDirection" + }, + { + "$ref": "#/components/schemas/DealStats" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" }, "tag": { "enum": [ - "ByAccountDraw" + "ByDS" ], "type": "string" } @@ -4483,7 +4874,7 @@ "tag", "contents" ], - "title": "ByAccountDraw", + "title": "ByDS", "type": "object" }, { @@ -4506,7 +4897,7 @@ }, "tag": { "enum": [ - "ByDS" + "Till" ], "type": "string" } @@ -4515,7 +4906,7 @@ "tag", "contents" ], - "title": "ByDS", + "title": "Till", "type": "object" } ] @@ -5320,41 +5711,6 @@ "title": "PreClosingDates", "type": "object" }, - { - "properties": { - "contents": { - "items": [ - { - "$ref": "#/components/schemas/Day" - }, - { - "$ref": "#/components/schemas/DatePattern" - }, - { - "$ref": "#/components/schemas/DatePattern" - }, - { - "$ref": "#/components/schemas/Day" - } - ], - "maxItems": 4, - "minItems": 4, - "type": "array" - }, - "tag": { - "enum": [ - "WarehousingDates" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "WarehousingDates", - "type": "object" - }, { "properties": { "contents": { @@ -5422,6 +5778,28 @@ ], "title": "CurrentDates", "type": "object" + }, + { + "properties": { + "contents": { + "additionalProperties": { + "$ref": "#/components/schemas/DatePattern" + }, + "type": "object" + }, + "tag": { + "enum": [ + "GenericDates" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "GenericDates", + "type": "object" } ] }, @@ -5665,6 +6043,25 @@ "title": "CustomDate", "type": "object" }, + { + "properties": { + "contents": { + "$ref": "#/components/schemas/Day" + }, + "tag": { + "enum": [ + "SingletonDate" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "SingletonDate", + "type": "object" + }, { "properties": { "contents": { @@ -6144,6 +6541,28 @@ "title": "OriginalBondBalanceOf", "type": "object" }, + { + "properties": { + "contents": { + "items": { + "type": "string" + }, + "type": "array" + }, + "tag": { + "enum": [ + "BondTotalFunding" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondTotalFunding", + "type": "object" + }, { "properties": { "contents": { @@ -7033,6 +7452,42 @@ "title": "BondDuePrin", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "items": { + "$ref": "#/components/schemas/TsPoint_(Fixed_*_E2)" + }, + "type": "array" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + "tag": { + "enum": [ + "BondReturn" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondReturn", + "type": "object" + }, { "properties": { "contents": { @@ -7251,7 +7706,61 @@ }, "tag": { "enum": [ - "AccTxnAmtBy" + "AccTxnAmtBy" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "AccTxnAmtBy", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "items": { + "type": "string" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "FeesPaidAt" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "FeesPaidAt", + "type": "object" + }, + { + "properties": { + "contents": { + "items": { + "type": "string" + }, + "type": "array" + }, + "tag": { + "enum": [ + "CurrentDueBondInt" ], "type": "string" } @@ -7260,7 +7769,7 @@ "tag", "contents" ], - "title": "AccTxnAmtBy", + "title": "CurrentDueBondInt", "type": "object" }, { @@ -7268,7 +7777,9 @@ "contents": { "items": [ { - "$ref": "#/components/schemas/Day" + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" }, { "items": { @@ -7283,7 +7794,7 @@ }, "tag": { "enum": [ - "FeesPaidAt" + "CurrentDueBondIntAt" ], "type": "string" } @@ -7292,7 +7803,7 @@ "tag", "contents" ], - "title": "FeesPaidAt", + "title": "CurrentDueBondIntAt", "type": "object" }, { @@ -7305,7 +7816,7 @@ }, "tag": { "enum": [ - "CurrentDueBondInt" + "CurrentDueBondIntOverInt" ], "type": "string" } @@ -7314,20 +7825,32 @@ "tag", "contents" ], - "title": "CurrentDueBondInt", + "title": "CurrentDueBondIntOverInt", "type": "object" }, { "properties": { "contents": { - "items": { - "type": "string" - }, + "items": [ + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + }, + { + "items": { + "type": "string" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, "type": "array" }, "tag": { "enum": [ - "CurrentDueBondIntOverInt" + "CurrentDueBondIntOverIntAt" ], "type": "string" } @@ -7336,7 +7859,7 @@ "tag", "contents" ], - "title": "CurrentDueBondIntOverInt", + "title": "CurrentDueBondIntOverIntAt", "type": "object" }, { @@ -7361,6 +7884,40 @@ "title": "CurrentDueBondIntTotal", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + }, + { + "items": { + "type": "string" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "CurrentDueBondIntTotalAt" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "CurrentDueBondIntTotalAt", + "type": "object" + }, { "properties": { "contents": { @@ -7789,6 +8346,36 @@ "title": "CustomData", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "format": "double", + "type": "number" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "AmountRequiredForTargetIRR" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "AmountRequiredForTargetIRR", + "type": "object" + }, { "properties": { "contents": { @@ -8142,10 +8729,7 @@ { "properties": { "contents": { - "items": { - "$ref": "#/components/schemas/PoolId" - }, - "type": "array" + "$ref": "#/components/schemas/PoolId" }, "tag": { "enum": [ @@ -9375,7 +9959,17 @@ "type": "string" }, { - "$ref": "#/components/schemas/BookType" + "items": [ + { + "$ref": "#/components/schemas/BookDirection" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" } ], "maxItems": 2, @@ -10398,17 +10992,38 @@ }, { "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Pre" + }, + { + "type": "string" + }, + { + "type": "string" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 4, + "minItems": 4, + "type": "array" + }, "tag": { "enum": [ - "DummyIssueBondEvent" + "FundingBondEvent" ], "type": "string" } }, "required": [ - "tag" + "tag", + "contents" ], - "title": "DummyIssueBondEvent", + "title": "FundingBondEvent", "type": "object" } ] @@ -13677,6 +14292,25 @@ "title": "PvRate", "type": "object" }, + { + "properties": { + "contents": { + "$ref": "#/components/schemas/Ts" + }, + "tag": { + "enum": [ + "PvWal" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "PvWal", + "type": "object" + }, { "properties": { "contents": { @@ -13938,6 +14572,9 @@ }, "RateSwap": { "properties": { + "rsDayCount": { + "$ref": "#/components/schemas/DayCount" + }, "rsLastStlDate": { "$ref": "#/components/schemas/Day" }, @@ -13961,7 +14598,17 @@ "type": "number" }, "rsSettleDates": { - "$ref": "#/components/schemas/DatePattern" + "items": [ + { + "$ref": "#/components/schemas/DatePattern" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "rsStartDate": { "$ref": "#/components/schemas/Day" @@ -13971,17 +14618,21 @@ }, "rsType": { "$ref": "#/components/schemas/RateSwapType" + }, + "rsUpdateDates": { + "$ref": "#/components/schemas/DatePattern" } }, "required": [ "rsType", - "rsSettleDates", + "rsDayCount", + "rsUpdateDates", "rsNotional", - "rsStartDate", + "rsRefBalance", "rsPayingRate", "rsReceivingRate", - "rsRefBalance", - "rsNetCash" + "rsNetCash", + "rsStartDate" ], "type": "object" }, @@ -14181,6 +14832,86 @@ ], "title": "FixedToFloating", "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/DealStats" + }, + { + "items": [ + { + "$ref": "#/components/schemas/Index" + }, + { + "multipleOf": 1.0e-6, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "FormulaToFloating" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "FormulaToFloating", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "items": [ + { + "$ref": "#/components/schemas/Index" + }, + { + "multipleOf": 1.0e-6, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + { + "$ref": "#/components/schemas/DealStats" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "FloatingToFormula" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "FloatingToFormula", + "type": "object" } ] }, @@ -18944,6 +19675,9 @@ }, { "properties": { + "contents": { + "type": "string" + }, "tag": { "enum": [ "SwapInSettle" @@ -18952,13 +19686,17 @@ } }, "required": [ - "tag" + "tag", + "contents" ], "title": "SwapInSettle", "type": "object" }, { "properties": { + "contents": { + "type": "string" + }, "tag": { "enum": [ "SwapOutSettle" @@ -18967,7 +19705,8 @@ } }, "required": [ - "tag" + "tag", + "contents" ], "title": "SwapOutSettle", "type": "object" @@ -19275,7 +20014,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.40.10" + "version": "0.41.0" }, "openapi": "3.0.0", "paths": { diff --git a/test/MainTest.hs b/test/MainTest.hs index 757d310d..9e43e2d6 100644 --- a/test/MainTest.hs +++ b/test/MainTest.hs @@ -30,7 +30,6 @@ import qualified Lib as L import qualified Stmt as S import qualified Data.Time as T import qualified Data.Vector as UtilT -import qualified UT.AnalyticsTest as AnalyticsT import qualified UT.UtilTest as RH import qualified UT.RateHedgeTest as RHT import GHC.Generics (U1(U1)) @@ -104,6 +103,7 @@ tests = testGroup "Tests" [AT.mortgageTests ,AnalyticsT.durationTest ,AnalyticsT.fvTest ,AnalyticsT.assetPricingTest + ,AnalyticsT.irrTest ,DealTest.baseTests ,RevolvingTest.baseTests --,DealMultiTest.baseTests diff --git a/test/UT/AnalyticsTest.hs b/test/UT/AnalyticsTest.hs index 44ca8855..eea8ba11 100644 --- a/test/UT/AnalyticsTest.hs +++ b/test/UT/AnalyticsTest.hs @@ -1,4 +1,4 @@ -module UT.AnalyticsTest(walTest,durationTest,fvTest,assetPricingTest) +module UT.AnalyticsTest(walTest,durationTest,fvTest,assetPricingTest,irrTest) where import Test.Tasty @@ -49,7 +49,8 @@ durationTest = (L.mkRateTs [(L.toDate "20230101",0.01)])) ] -fvTest = testGroup "FV Test" [ +fvTest = + testGroup "FV Test" [ testCase "FV2 test" $ assertEqual "1-year" 108 @@ -58,7 +59,7 @@ fvTest = testGroup "FV Test" [ assertEqual "0.5-year" 103.89 (fv2 0.08 (L.toDate "20230101") (L.toDate "20230701") 100) - ] + ] assetPricingTest = testGroup "Pricing on Asset" [ @@ -80,5 +81,18 @@ assetPricingTest = (LoanAssump Nothing Nothing Nothing Nothing,DummyDelinqAssump,DummyDefaultAssump) Nothing Exc) - ] + +irrTest = + testGroup "Irr Test" [ + testCase "required Amount with 8%" $ + assertEqual "12 months" + (Just 108.01) + (calcRequiredAmtForIrrAtDate 0.08 (L.toDates ["20230101"]) + [-100] + (L.toDate "20240101")) + ] + -- ,testCase "FV2 test" $ + -- assertEqual "0.5-year" + -- 103.89 + -- (fv2 0.08 (L.toDate "20230101") (L.toDate "20230701") 100) diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs index e42a4883..2f136dd9 100644 --- a/test/UT/DealTest.hs +++ b/test/UT/DealTest.hs @@ -297,7 +297,7 @@ poolFlowTest = ,testCase "last bond A payment date" $ assertEqual "pool bal should equal to total collect" - (Just (BondTxn (toDate "20240225") 0.00 0.00 30.56 0.080000 30.56 0.00 0.00 (Just 0.0) (TxnComments [PayInt ["A"],PayPrin ["A"]]))) + (Just (BondTxn (toDate "20240225") 0.00 0.00 30.56 0.080000 30.56 0.00 0.00 (Just 0.0) (PayPrin ["A"]))) $ (\s -> last (view Stmt.statementTxns s)) <$> (L.bndStmt $ (bndMap Map.! "A")) ] @@ -358,10 +358,12 @@ dateTests = testGroup "Deal Tests" [ testCase "Dates pattern" $ assertEqual "" - ((toDate "20220601"), (toDate "20220610"),(toDate "20220715") - ,[PoolCollection (toDate "20220630") "",PoolCollection (toDate "20220731") "",PoolCollection (toDate "20220831") ""] - ,[RunWaterfall (toDate "20220715") "",RunWaterfall (toDate "20220810") ""] - ,(toDate "20220901") ) + (Right $ + ((toDate "20220601"), (toDate "20220610"),(toDate "20220715") + ,[PoolCollection (toDate "20220630") "",PoolCollection (toDate "20220731") "",PoolCollection (toDate "20220831") ""] + ,[RunWaterfall (toDate "20220715") "",RunWaterfall (toDate "20220810") ""] + ,(toDate "20220901") + ,[])) (populateDealDates a Amortizing) ]