From 253a32d4c8ace45dadbe478e4576f5e5901b5ff8 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Thu, 29 May 2025 23:38:37 +0800 Subject: [PATCH 01/49] Safecheck: recovery dist shall equal to 1 --- src/Analytics.hs | 10 +++--- src/Asset.hs | 1 + src/AssetClass/Receivable.hs | 65 +++++++++++++++++++++--------------- src/Assumptions.hs | 1 + src/Cashflow.hs | 5 +-- 5 files changed, 46 insertions(+), 36 deletions(-) diff --git a/src/Analytics.hs b/src/Analytics.hs index e2a737a4..3a86ab5e 100644 --- a/src/Analytics.hs +++ b/src/Analytics.hs @@ -155,8 +155,8 @@ calcRequiredAmtForIrrAtDate irr ds vs d = def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.00000001} in case ridders def (0.0001,100000000000000) (calcPvFromIRR irr ds vs d) of - Root finalAmt -> Just (fromRational (toRational finalAmt)) - _ -> Nothing + Root finalAmt -> Just (fromRational (toRational finalAmt)) + _ -> Nothing -- ^ calc IRR from a cashflow calcIRR :: [Date] -> [Amount] -> Either String Rate @@ -174,6 +174,6 @@ calcIRR ds vs sumOfPv irr = pv22 irr beginDate ds vs' in case ridders def (-1,1000) sumOfPv of - Root irrRate -> Right $ toRational irrRate - NotBracketed -> Left $ "IRR: not bracketed" ++ show vs' ++ " and dates"++ show ds - SearchFailed -> Left $ "IRR: search failed: can't be calculated with input "++ show vs++" and dates"++ show ds + Root irrRate -> Right $ toRational irrRate + NotBracketed -> Left $ "IRR: not bracketed" ++ show vs' ++ " and dates"++ show ds + SearchFailed -> Left $ "IRR: search failed: can't be calculated with input "++ show vs++" and dates"++ show ds diff --git a/src/Asset.hs b/src/Asset.hs index bde510f4..6686bd20 100644 --- a/src/Asset.hs +++ b/src/Asset.hs @@ -215,6 +215,7 @@ buildPrepayRates a ds mPa = buildDefaultRates :: Asset b => b -> [Date] -> Maybe A.AssetDefaultAssumption -> Either String [Rate] buildDefaultRates _ ds Nothing = Right $ replicate (pred (length ds)) 0.0 +buildDefaultRates a [] mDa = Left "buildDefaultRates: empty date list" buildDefaultRates a ds mDa = normalPerfVector <$> case mDa of diff --git a/src/AssetClass/Receivable.hs b/src/AssetClass/Receivable.hs index a9c51472..7845ea5d 100644 --- a/src/AssetClass/Receivable.hs +++ b/src/AssetClass/Receivable.hs @@ -36,16 +36,22 @@ import qualified Asset as A debug = flip trace -buildRecoveryCfs :: StartDate -> Balance -> Maybe A.RecoveryAssumption -> [CF.TsRow] -buildRecoveryCfs _ _ Nothing = [] +-- project recovery cashflow from recovery assumption and defaulted balance +buildRecoveryCfs :: StartDate -> Balance -> Maybe A.RecoveryAssumption -> Either String [CF.TsRow] +buildRecoveryCfs _ _ Nothing = Right [] buildRecoveryCfs sd defaultedBal (Just (A.RecoveryByDays r dists)) = let totalRecoveryAmt = mulBR defaultedBal r - recoveryAmts = mulBR totalRecoveryAmt <$> (snd <$> dists) - recoveryDates = (\x -> T.addDays (toInteger x)) <$> (fst <$> dists) <*> [sd] - lossAmts = (take (pred (length recoveryDates)) (repeat 0)) ++ [defaultedBal - totalRecoveryAmt] - in - [ CF.ReceivableFlow d 0 0 0 0 0 amt lossAmt Nothing | (amt,d,lossAmt) <- zip3 recoveryAmts recoveryDates lossAmts] + recoveryDistribution = snd <$> dists + in + case sum recoveryDistribution of + 1 -> let + recoveryAmts = mulBR totalRecoveryAmt <$> recoveryDistribution + recoveryDates = (\x -> T.addDays (toInteger x)) <$> (fst <$> dists) <*> [sd] + lossAmts = replicate (pred (length recoveryDates)) 0 ++ [defaultedBal - totalRecoveryAmt] + in + Right $ [ CF.ReceivableFlow d 0 0 0 0 0 amt lossAmt Nothing | (amt,d,lossAmt) <- zip3 recoveryAmts recoveryDates lossAmts] + _ -> Left $ "Recovery distribution does not sum up to 1, got " ++ show (sum recoveryDistribution) ++ " for " ++ show dists calcDueFactorFee :: Receivable -> Date -> Balance @@ -56,17 +62,17 @@ calcDueFactorFee r@(Invoice (ReceivableInfo sd ob oa dd ft obr) st) asOfDay Just (FixedRateFee r) -> mulBR ob r Just (FactorFee r daysInPeriod rnd) -> let - periods = case rnd of - Up -> ceiling ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int - Down -> floor ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int + periods = case rnd of + Up -> ceiling ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int + Down -> floor ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int in - fromRational $ (toRational periods) * toRational (mulBR ob r) + fromRational $ (toRational periods) * toRational (mulBR ob r) Just (AdvanceFee r) -> mulBR oa (r * (yearCountFraction DC_ACT_365F sd dd)) Just (CompoundFee fs) -> let - newReceivables = [ Invoice (ReceivableInfo sd ob oa dd (Just newFeeType) obr) st | newFeeType <- fs] + newReceivables = [ Invoice (ReceivableInfo sd ob oa dd (Just newFeeType) obr) st | newFeeType <- fs] in - sum $ (`calcDueFactorFee` asOfDay) <$> newReceivables + sum $ (`calcDueFactorFee` asOfDay) <$> newReceivables instance Asset Receivable where @@ -106,7 +112,7 @@ instance Asset Receivable where Invoice (ReceivableInfo newDate ob oa (T.addDays gaps newDate) ft obr) st splitWith r@(Invoice (ReceivableInfo sd ob oa dd ft obr) st) rs - = [ (Invoice (ReceivableInfo sd (mulBR ob ratio) (mulBR oa ratio) dd ft obr) st) | ratio <- rs ] + = [ Invoice (ReceivableInfo sd (mulBR ob ratio) (mulBR oa ratio) dd ft obr) st | ratio <- rs ] -- Defaulted Invoice projCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) (Defaulted _)) @@ -121,23 +127,27 @@ instance Asset Receivable where (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) - -- Performing Invoice + -- Performing Invoice : default all balance at end of due date projCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) Current) asOfDay massump@(A.ReceivableAssump (Just A.DefaultAtEnd) 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] + = let + payDate = dd + feeDue = calcDueFactorFee r payDate + -- initTxn = [CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing] - realizedLoss = case amr of - Nothing -> ob - Just _ -> 0 - txns = [CF.ReceivableFlow payDate 0 0 0 0 ob 0 realizedLoss Nothing] - (futureTxns,historyM)= CF.cutoffTrs asOfDay $ txns++(buildRecoveryCfs payDate ob amr) + realizedLoss = case amr of + Nothing -> ob + Just _ -> 0 + txns = [CF.ReceivableFlow payDate 0 0 0 0 ob 0 realizedLoss Nothing] + in + do + recoveryFlow <- buildRecoveryCfs payDate ob amr + let (futureTxns,historyM) = CF.cutoffTrs asOfDay $ txns++recoveryFlow + return $ (CF.CashFlowFrame (ob,asOfDay,Nothing) futureTxns, historyM) + -- Performing Invoice : projCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) Current) asOfDay massump@(A.ReceivableAssump amd amr ams, _ , _) @@ -151,7 +161,7 @@ instance Asset Receivable where defaultRates <- A.buildDefaultRates r (sd:[dd]) amd let defaultAmt = mulBR ob (head defaultRates) let afterDefaultBal = ob - defaultAmt - let afterDefaultFee = mulBR feeDue (1 - (head defaultRates)) + let afterDefaultFee = mulBR feeDue (1 - head defaultRates) let feePaid = min afterDefaultBal afterDefaultFee let principal = max 0 $ afterDefaultBal - feePaid @@ -161,7 +171,8 @@ instance Asset Receivable where Just _ -> 0 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)) + recoveryFlow <- buildRecoveryCfs payDate defaultAmt amr + let (futureTxns,historyM) = CF.cutoffTrs asOfDay $ txns++recoveryFlow 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 bb6e64f8..b5437f1f 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -294,6 +294,7 @@ getRateAssumption assumps idx -- | project rates used by rate type ,with interest rate assumptions and observation dates projRates :: IRate -> RateType -> Maybe [RateAssumption] -> [Date] -> Either String [IRate] +projRates sr _ _ [] = Left "No dates provided for rate projection" 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 diff --git a/src/Cashflow.hs b/src/Cashflow.hs index dde9309e..7ec52fa8 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -9,7 +9,7 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,mflowInterest,mflowPrincipal,mflowRecovery,mflowPrepayment ,mflowRental,mflowRate,sumPoolFlow,splitTrs,aggregateTsByDate ,mflowDefault,mflowLoss - ,getSingleTsCashFlowFrame,getDatesCashFlowFrame + ,getDatesCashFlowFrame ,lookupSource,lookupSourceM,combineTss ,mflowBegBalance,tsDefaultBal ,mflowBorrowerNum,mflowPrepaymentPenalty,tsRowBalance @@ -246,9 +246,6 @@ cfAt (CashFlowFrame _ trs) idx cfInsertHead :: TsRow -> CashFlowFrame -> CashFlowFrame cfInsertHead tr (CashFlowFrame st trs) = CashFlowFrame st $ tr:trs -getSingleTsCashFlowFrame :: CashFlowFrame -> Date -> TsRow -getSingleTsCashFlowFrame (CashFlowFrame _ trs) d - = head $ filter (\x -> getDate x == d) trs splitCashFlowFrameByDate :: CashFlowFrame -> Date -> SplitType -> (CashFlowFrame,CashFlowFrame) splitCashFlowFrameByDate (CashFlowFrame status txns) d st From 9a99681758786eeb100fead02753455513399d39 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Thu, 5 Jun 2025 22:44:47 +0800 Subject: [PATCH 02/49] expose triggerEffect: change bond interet type --- src/Deal.hs | 17 +++++++++++++++++ src/Deal/DealBase.hs | 23 ++++++++++++++++++++++- src/Triggers.hs | 2 ++ 3 files changed, 41 insertions(+), 1 deletion(-) diff --git a/src/Deal.hs b/src/Deal.hs index e33dc5be..048144ae 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -344,6 +344,23 @@ runEffects (t@TestDeal{accounts = accMap, fees = feeMap ,status=st, bonds = bond (newT, newRc, newLogs) <- foldM (performActionWrap d) (t, rc, DL.empty) wActions return (newT, newRc, actions, DL.append logs newLogs) + ChangeBondRate bName bRateType bRate -> + let + -- accrual rate + -- set current rate + -- update rate component + updateFn b = L.accrueInt d b + & set L.interestInfoTraversal bRateType + & set L.curRatesTraversal bRate + -- updated deal + t' = t {bonds = updateBondInMap bName updateFn bondMap} + -- build bond rate reset actions + newActions = case getBondByName t' True bName of + Just bnd -> [ ResetBondRate _d bName | _d <- L.buildRateResetDates bnd d (getDate (last actions))] + Nothing -> [] + in + Right (t' , rc, sortBy sortActionOnDate (newActions++actions), logs) + DoNothing -> Right (t, rc, actions, DL.empty) _ -> Left $ "Date:"++ show d++" Failed to match trigger effects: "++show te diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index 6b0ab338..e010e076 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -14,7 +14,7 @@ module Deal.DealBase (TestDeal(..),SPV(..),dealBonds,dealFees,dealAccounts,dealP ,viewDealBondsByNames,poolTypePool,viewBondsInMap,bondGroupsBonds ,increaseBondPaidPeriod,increasePoolCollectedPeriod ,DealStatFields(..),getDealStatInt,isPreClosing,populateDealDates - ,bondTraversal,findBondByNames + ,bondTraversal,findBondByNames,updateBondInMap ) where import qualified Accounts as A @@ -141,6 +141,7 @@ instance TimeSeries ActionOnDate where getDate (ResetLiqProviderRate d _) = d getDate (TestCall d) = d getDate (FundBond d _ _ _ _) = d + getDate (HitStatedMaturity d) = d getDate x = error $ "Failed to match"++ show x @@ -473,6 +474,26 @@ bondGroupsBonds = lens getter setter setter (L.BondGroup b x) newBMap = L.BondGroup newBMap x setter x _ = x +updateBondInMap :: BondName -> (L.Bond -> L.Bond) -> Map.Map BondName L.Bond -> Map.Map BondName L.Bond +updateBondInMap bName f bMap + = let + fn _bName (L.BondGroup subMap bt) = L.BondGroup (Map.adjust f _bName subMap) bt + fn _bName bnd + | _bName == bName = f bnd + | otherwise = bnd + in + Map.mapWithKey fn bMap + +-- updateBondInMap' :: BondName -> (L.Bond -> Either String L.Bond) -> Map.Map BondName L.Bond -> Either String (Map.Map BondName L.Bond) +-- updateBondInMap' bName f bMap +-- = let +-- fn _bName (L.BondGroup subMap bt) = L.BondGroup (Map.adjust f _bName subMap) bt +-- fn _bName bnd +-- | _bName == bName = f bnd +-- | otherwise = Right bnd +-- in +-- traverse fn bMap + dealAccounts :: Ast.Asset a => Lens' (TestDeal a) (Map.Map AccountName A.Account) dealAccounts = lens getter setter where diff --git a/src/Triggers.hs b/src/Triggers.hs index c4e70325..0fe70e6e 100644 --- a/src/Triggers.hs +++ b/src/Triggers.hs @@ -9,6 +9,7 @@ module Triggers( import qualified Data.Text as T import qualified Stmt as S +import qualified Liability as L import Text.Read (readMaybe) import Lib import Types @@ -37,6 +38,7 @@ data TriggerEffect = DealStatusTo DealStatus -- ^ chan (Maybe [CollectionRule]) -- ^ close the deal | BuyAsset AccountName PricingMethod -- ^ buy asset from the assumption using funds from account + | ChangeBondRate BondName L.InterestInfo IRate -- ^ change bond rate | TriggerEffects [TriggerEffect] -- ^ a combination of effects above | RunActions [Action] -- ^ run a list of waterfall actions | DoNothing -- ^ do nothing From 6c0fee7ed5598a2029c52b27ef9bb34f631bae0f Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Fri, 6 Jun 2025 00:44:47 +0800 Subject: [PATCH 03/49] expose lease endType( earlier & later) --- src/AssetClass/Lease.hs | 17 +++++++- src/Assumptions.hs | 2 + swagger.json | 97 ++++++++++++++++++++++++++++++++++++++++- 3 files changed, 113 insertions(+), 3 deletions(-) diff --git a/src/AssetClass/Lease.hs b/src/AssetClass/Lease.hs index 6e25365c..10f90ac5 100644 --- a/src/AssetClass/Lease.hs +++ b/src/AssetClass/Lease.hs @@ -91,7 +91,7 @@ nextLease :: Lease -> (AP.LeaseAssetRentAssump, TermChangeRate, DayGap) -> (Leas nextLease l@(RegularLease (LeaseInfo sd ot rental ob) bal rt _) (rAssump,tc,gd) = let leaseEndDate = last $ getPaymentDates l 0 - nextStartDate = T.addDays (succ (toInteger gd)) leaseEndDate -- `debug` ("Gap Day ->"++ show gd) + nextStartDate = T.addDays (succ (toInteger gd)) leaseEndDate nextOriginTerm = round $ mulIR ot (1+tc) nextEndDate = calcEndDate nextStartDate ot rental @@ -102,7 +102,7 @@ nextLease l@(RegularLease (LeaseInfo sd ot rental ob) bal rt _) (rAssump,tc,gd) newBal nextOriginTerm Current ,nextEndDate ,(newRassump,tc,gd) - ) -- `debug` ("1+tc"++show (1+tc) ++">>"++ show (mulIR ot (1+tc))) + ) nextLease l@(StepUpLease (LeaseInfo sd ot rental ob) lsteupInfo bal rt _) (rAssump,tc,gd) = let @@ -133,6 +133,19 @@ nextLeaseTill l (rsc,tc,mg) lastDate (AP.StopByExtTimes n) accum where (new_lease,new_lastDate, newAssump) = nextLease l (rsc,tc,mg) +nextLeaseTill l (rsc,tc,mg) lastDate (AP.EarlierOf ed n) accum + | lastDate >= ed = accum + | n == 0 = accum + | otherwise = nextLeaseTill new_lease newAssump new_lastDate (AP.EarlierOf ed (pred n)) (accum++[new_lease]) + where + (new_lease,new_lastDate, newAssump) = nextLease l (rsc,tc,mg) + +nextLeaseTill l (rsc,tc,mg) lastDate (AP.LaterOf ed n) accum + | lastDate >= ed && n == 0 = accum + | otherwise = nextLeaseTill new_lease newAssump new_lastDate (AP.LaterOf ed (pred n)) (accum++[new_lease]) + where + (new_lease,new_lastDate, newAssump) = nextLease l (rsc,tc,mg) + -- ^ calculate the daily rate for a step up lease calcPmts :: LeaseStepUp -> [Rate] -> Amount -> Either String [Amount] calcPmts (FlatRate _r) fs amt = Right (scanl mulBR amt (replicate (length fs) _r)) diff --git a/src/Assumptions.hs b/src/Assumptions.hs index b5437f1f..71813ca2 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -204,6 +204,8 @@ data LeaseDefaultType = DefaultByContinuation Rate data LeaseEndType = CutByDate Date | StopByExtTimes Int + | EarlierOf Date Int + | LaterOf Date Int deriving (Show,Generic,Read) data ExtraStress = ExtraStress { diff --git a/swagger.json b/swagger.json index cfe016a3..20377d47 100644 --- a/swagger.json +++ b/swagger.json @@ -10924,6 +10924,68 @@ ], "title": "StopByExtTimes", "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "EarlierOf" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "EarlierOf", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "LaterOf" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "LaterOf", + "type": "object" } ] }, @@ -18551,6 +18613,39 @@ "title": "BuyAsset", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "$ref": "#/components/schemas/InterestInfo" + }, + { + "multipleOf": 1.0e-6, + "type": "number" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + "tag": { + "enum": [ + "ChangeBondRate" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "ChangeBondRate", + "type": "object" + }, { "properties": { "contents": { @@ -20738,7 +20833,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.45.6" + "version": "0.45.7" }, "openapi": "3.0.0", "paths": { From e2861833596040ebf6ac415b0ee5caf39325f00f Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sat, 7 Jun 2025 15:52:52 +0800 Subject: [PATCH 04/49] refactor on root finder --- app/Main.hs | 79 +++++-- app/MainBase.hs | 33 ++- src/Liability.hs | 5 +- src/Types.hs | 64 ++--- swagger.json | 593 ++++++++++++++++------------------------------- 5 files changed, 317 insertions(+), 457 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index c92a21d4..f741b6ff 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -303,7 +303,7 @@ testByDefault dt assumps nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevo let bondBal = L.getOutstandingAmount $ (getDealBondMap d) Map.! bn in - (fromRational (toRational bondBal) - 0.01) -- `debug` (">>> test run result"++ show (fromRational (toRational bondBal) - 0.01)) + (fromRational (toRational bondBal) - 0.01) Left errorMsg -> error $ "Error in test fun for first loss" ++ show errorMsg @@ -330,36 +330,69 @@ testBySpread (dt,mPAssump,runAssump) (bn,otherBondFlag,otherFeeFlag) f if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0 then -1 else - (fromRational . toRational) $ bondBal - v -- `debug` ("rate"++ show f ++ "bondBal:"++ show bondBal++"v:"++ show v) + (fromRational . toRational) $ bondBal - v Left errorMsg -> error $ "Error in test fun for spread testing" ++ show errorMsg +doTweak :: Double -> RootFindTweak -> DealRunInput -> DealRunInput +doTweak r StressPoolDefault (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) + = let + stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressAssetPerf (toRational r)) assumps + stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (toRational r) mRevolving } + in + (dt ,Just stressed, stressedNonPerf) +doTweak r (MaxSpreadTo bn) (dt , mAssump, rAssump) + = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump) + +evalRootFindStop :: RootFindStop -> RunRespRight -> Double +evalRootFindStop (BondIncurLoss bn) (dt,_,_,_) + = let + bondBal = L.getOutstandingAmount $ getDealBondMap dt Map.! bn + in + (fromRational . toRational) $ bondBal - 0.01 + +evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_,pResult) + = let + -- bnds + otherBondsName = [] + -- check fees/other bonds + otherBondOustanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealBondMap dt) + otherBondOustanding False = 0.0 + feeOutstanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealFeeMap dt) + feeOutstanding False = 0.0 + v = getPriceValue $ pResult Map.! bn + bondBal = L.getOriginBalance $ getDealBondMap dt Map.! bn + in + if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0 then + -1 + else + (fromRational . toRational) $ bondBal - v + +evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) + = let + v = L.extractIrrResult $ pResult Map.! bn + in + case v of + Nothing -> -1 + Just irr -> (fromRational . toRational) $ irr - target + +rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double +rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r + = let + (dt' ,poolAssumps', runAssumps') = doTweak r tweak (dt ,poolAssumps, runAssumps) + in + case wrapRun dt' poolAssumps' runAssumps' of + Right runRespRight -> evalRootFindStop stop runRespRight + Left errorMsg -> -1 + runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) -runRootFinderBy (FirstLossReq (dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) bn) +runRootFinderBy (RFReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) tweak stop) = return $ let itertimes = 500 def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.0001} in - case ridders def (500.0,0.00) (testByDefault dt assumps nonPerfAssump bn) of - Root r -> Right $ - FirstLossResult - r - (over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressAssetPerf (toRational r)) assumps) - (stressRevovlingPerf (toRational r) mRevolving) - NotBracketed -> Left "Not able to bracket the root" - SearchFailed -> Left "Not able to find the root" - -runRootFinderBy (MaxSpreadToFaceReq (dt,pAssump,dAssump) bns chkOtherBnds chkOtherFees) - = return $ - let - itertimes = 500 - def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.0001} - in - case ridders def (0.00,200.0) (testBySpread (dt,pAssump,dAssump) (bns,chkOtherBnds,chkOtherFees)) of - Root r -> let - dt' = modifyDealType (DM.AddSpreadToBonds bns) r dt - in - Right $ BestSpreadResult r (getDealBondMap dt') dt' + case ridders def (500.0,0.00) (rootFindAlgo req tweak stop) of + Root r -> Right $ RFResult r (doTweak r tweak req) NotBracketed -> Left "Not able to bracket the root" SearchFailed -> Left "Not able to find the root" diff --git a/app/MainBase.hs b/app/MainBase.hs index 50e7e143..f466c894 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -15,8 +15,8 @@ module MainBase(DealType(..),RunResp,PoolTypeWrap(..),RunPoolTypeRtn,RunPoolTypeRtn_ ,RunAssetReq(..),RunAssetResp,ScenarioName,DealRunInput,RunDealReq(..),RunSimDealReq(..),RunPoolReq(..) - ,RunDateReq(..),Version(..) - ,RootFindReq(..),RootFindResp(..),TargetBonds,PoolRunResp + ,RunDateReq(..),Version(..),RunRespRight + ,RootFindReq(..),RootFindResp(..),TargetBonds,PoolRunResp,RootFindTweak(..),RootFindStop(..) ) where @@ -143,9 +143,9 @@ data RunDealReq = SingleRunReq DealType (Maybe AP.ApplyAssumptionType) AP.NonPer data RunSimDealReq = OASReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption deriving(Show, Generic) -type RunResp = Either String (DealType , Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent],Map.Map String PriceResult) - +type RunRespRight = (DealType , Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent],Map.Map String PriceResult) +type RunResp = Either String RunRespRight data RunPoolReq = SingleRunPoolReq PoolTypeWrap (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) | MultiScenarioRunPoolReq PoolTypeWrap (Map.Map ScenarioName AP.ApplyAssumptionType) (Maybe [RateAssumption]) @@ -158,10 +158,6 @@ instance ToSchema RunDateReq type PoolRunResp = Either String (Map.Map PoolId (CF.CashFlowFrame, Map.Map CutoffFields Balance)) -data RootFindResp = FirstLossResult Double AP.ApplyAssumptionType (Maybe AP.RevolvingAssumption) - | BestSpreadResult Double (Map.Map BondName L.Bond) DealType - deriving(Show, Generic) - type TargetBonds = [BondName] -- calcualte best spread that @@ -169,11 +165,30 @@ type TargetBonds = [BondName] --- 2. make sure WAC cap is met data RootFindReq = FirstLossReq DealRunInput BondName | MaxSpreadToFaceReq DealRunInput BondName Bool Bool + | RootFinderReq DealRunInput RootFindTweak RootFindStop deriving(Show, Generic) -instance ToSchema RootFindReq +data RootFindTweak = StressPoolDefault -- stressed pool perf + | MaxSpreadTo BondName -- bond component + -- | SplitFixedBalance (BondName,BondName) -- bond component + deriving(Show, Generic) +data RootFindStop = BondIncurLoss BondName + | BondPricingEqOriginBal BondName Bool Bool + -- | BondMetTargetIrr BondName IRR + deriving(Show, Generic) + +data RootFindResp = RFResult Double DealRunInput + -- | BestSpreadResult Double (Map.Map BondName L.Bond) DealType + -- | FirstLossResult Double AP.ApplyAssumptionType (Maybe AP.RevolvingAssumption) + deriving(Show, Generic) +$(deriveJSON defaultOptions ''RootFindTweak) +$(deriveJSON defaultOptions ''RootFindStop) + +instance ToSchema RootFindReq +instance ToSchema RootFindTweak +instance ToSchema RootFindStop instance ToSchema CF.CashFlowFrame instance ToSchema AB.Loan instance ToSchema AB.Installment diff --git a/src/Liability.hs b/src/Liability.hs index c8095bc8..e5066f9f 100644 --- a/src/Liability.hs +++ b/src/Liability.hs @@ -20,7 +20,7 @@ module Liability ,getCurRate,bondCashflow,getOutstandingAmount,valueBond,getTxnRate ,getAccrueBegDate,getTxnInt,adjInterestInfoByRate,adjInterestInfoBySpread ,interestInfoTraversal,getOriginBalance,curRatesTraversal - ,backoutAccruedInt + ,backoutAccruedInt,extractIrrResult ) where @@ -533,6 +533,9 @@ priceBond d rc bnd valueBond :: BondPricingMethod -> Date -> [(Date,Balance)] -> Balance valueBond _ _ [] = 0 +extractIrrResult :: PriceResult -> Maybe IRR +extractIrrResult priceResult = fst <$> preview _IrrResult priceResult + backoutAccruedInt :: Date -> Date -> [Txn] -> Amount backoutAccruedInt d txnStartDate txns = case splitByDate txns d EqToLeft of diff --git a/src/Types.hs b/src/Types.hs index 28bc2c8f..d985753d 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -32,7 +32,7 @@ module Types ,ActionWhen(..),DealStatFields(..) ,getDealStatType,getPriceValue,preHasTrigger ,MyRatio,HowToPay(..),BondPricingMethod(..),InvestorAction(..) - ,_BondTxn ,_InspectBal + ,_BondTxn ,_InspectBal, _IrrResult ) where @@ -250,6 +250,29 @@ data PoolId = PoolName String -- ^ pool name | DealBondFlow DealName String Date Rate -- ^ bond flow from deal deriving (Eq,Ord,Generic) +instance Show PoolId where + show (PoolName n) = n + show PoolConsol = "PoolConsol" + show (DealBondFlow dn bn sd r) = "BondFlow:"++dn++":"++bn++":"++show sd++":"++show r + +instance (Read PoolId) where + readsPrec d "PoolConsol" = [(PoolConsol,"")] + readsPrec d rStr = + let + pn = Data.List.Split.splitOn ":" rStr + in + case pn of + [dn,bn,sd,r] -> + let + sd' = TF.parseTimeOrError True TF.defaultTimeLocale "%Y-%m-%d" sd + r' = read r::Rate + in + [(DealBondFlow dn bn sd' r',"")] + ["PoolName",pn] -> [(PoolName pn,"")] + _ -> error $ "Invalid PoolId: "++ show pn + + + data Cmp = G -- ^ Greater than | GE -- ^ Greater Equal than @@ -286,6 +309,9 @@ data PoolSource = CollectedInterest -- ^ interest data TsPoint a = TsPoint Date a deriving (Show,Eq,Read,Generic) +instance Ord a => Ord (TsPoint a) where + compare (TsPoint d1 tv1) (TsPoint d2 tv2) = compare d1 d2 + data PerPoint a = PerPoint Int a deriving (Show,Eq,Read,Generic) @@ -784,11 +810,13 @@ data CutoffFields = IssuanceBalance -- ^ pool issuance balance data PriceResult = PriceResult Valuation PerFace WAL Duration Convexity AccruedInterest [Txn] - | AssetPrice Valuation WAL Duration Convexity AccruedInterest - | OASResult PriceResult [Valuation] Spread - | ZSpread Spread - | IrrResult IRR [Txn] - deriving (Show, Eq, Generic) + | AssetPrice Valuation WAL Duration Convexity AccruedInterest + | OASResult PriceResult [Valuation] Spread + | ZSpread Spread + | IrrResult IRR [Txn] + deriving (Show, Eq, Generic) + +makePrisms ''PriceResult getPriceValue :: PriceResult -> Balance getPriceValue (AssetPrice v _ _ _ _ ) = v @@ -873,30 +901,8 @@ data TimeHorizion = ByMonth instance TimeSeries (TsPoint a) where getDate (TsPoint d a) = d -instance Ord a => Ord (TsPoint a) where - compare (TsPoint d1 tv1) (TsPoint d2 tv2) = compare d1 d2 - -- compare (PoolPeriodPoint i1 tv1) (PoolPeriodPoint i2 tv2) = compare i1 i2 -instance Show PoolId where - show (PoolName n) = n - show PoolConsol = "PoolConsol" - show (DealBondFlow dn bn sd r) = "BondFlow:"++dn++":"++bn++":"++show sd++":"++show r - -instance (Read PoolId) where - readsPrec d "PoolConsol" = [(PoolConsol,"")] - readsPrec d rStr = - let - pn = Data.List.Split.splitOn ":" rStr - in - case pn of - [dn,bn,sd,r] -> - let - sd' = TF.parseTimeOrError True TF.defaultTimeLocale "%Y-%m-%d" sd - r' = read r::Rate - in - [(DealBondFlow dn bn sd' r',"")] - ["PoolName",pn] -> [(PoolName pn,"")] - _ -> error $ "Invalid PoolId: "++ show pn + -- compare (PoolPeriodPoint i1 tv1) (PoolPeriodPoint i2 tv2) = compare i1 i2 $(deriveJSON defaultOptions ''DecimalRaw) diff --git a/swagger.json b/swagger.json index 20377d47..c7d0b96a 100644 --- a/swagger.json +++ b/swagger.json @@ -10184,13 +10184,6 @@ "properties": { "contents": { "items": [ - { - "multipleOf": 1.0e-6, - "type": "number" - }, - { - "$ref": "#/components/schemas/Index" - }, { "multipleOf": 1.0e-6, "type": "number" @@ -10199,54 +10192,16 @@ "$ref": "#/components/schemas/DatePattern" }, { - "$ref": "#/components/schemas/DayCount" - }, - { - "multipleOf": 1.0e-6, - "type": "number" - }, - { - "multipleOf": 1.0e-6, - "type": "number" - } - ], - "maxItems": 7, - "minItems": 7, - "type": "array" - }, - "tag": { - "enum": [ - "Floater" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "Floater", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "multipleOf": 1.0e-6, - "type": "number" - }, - { - "$ref": "#/components/schemas/DayCount" + "$ref": "#/components/schemas/Day" } ], - "maxItems": 2, - "minItems": 2, + "maxItems": 3, + "minItems": 3, "type": "array" }, "tag": { "enum": [ - "Fix" + "BankAccount" ], "type": "string" } @@ -10255,7 +10210,7 @@ "tag", "contents" ], - "title": "Fix", + "title": "BankAccount", "type": "object" }, { @@ -10263,145 +10218,33 @@ "contents": { "items": [ { - "$ref": "#/components/schemas/DealStats" + "$ref": "#/components/schemas/Index" }, - { - "$ref": "#/components/schemas/InterestInfo" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "RefBal" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "RefBal", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ { "multipleOf": 1.0e-6, "type": "number" }, { - "$ref": "#/components/schemas/DealStats" - }, - { - "format": "float", - "type": "number" + "$ref": "#/components/schemas/DatePattern" }, { "$ref": "#/components/schemas/DatePattern" - } - ], - "maxItems": 4, - "minItems": 4, - "type": "array" - }, - "tag": { - "enum": [ - "RefRate" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "RefRate", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "$ref": "#/components/schemas/InterestInfo" }, { - "multipleOf": 1.0e-6, - "type": "number" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "CapRate" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "CapRate", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "$ref": "#/components/schemas/InterestInfo" + "$ref": "#/components/schemas/Day" }, { "multipleOf": 1.0e-6, "type": "number" } ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "FloorRate" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "FloorRate", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "$ref": "#/components/schemas/InterestInfo" - }, - { - "$ref": "#/components/schemas/InterestOverInterestType" - } - ], - "maxItems": 2, - "minItems": 2, + "maxItems": 6, + "minItems": 6, "type": "array" }, "tag": { "enum": [ - "WithIoI" + "InvestmentAccount" ], "type": "string" } @@ -10410,7 +10253,7 @@ "tag", "contents" ], - "title": "WithIoI", + "title": "InvestmentAccount", "type": "object" } ] @@ -12101,219 +11944,28 @@ ] }, "OriginalInfo": { - "oneOf": [ - { - "properties": { - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originRate": { - "$ref": "#/components/schemas/RateType" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "period": { - "$ref": "#/components/schemas/Period" - }, - "prepaymentPenalty": { - "$ref": "#/components/schemas/PrepayPenaltyType" - }, - "prinType": { - "$ref": "#/components/schemas/AmortPlan" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "MortgageOriginalInfo" - ], - "type": "string" - } - }, - "required": [ - "originBalance", - "originRate", - "originTerm", - "period", - "startDate", - "prinType", - "tag" - ], - "title": "MortgageOriginalInfo", - "type": "object" - }, - { - "properties": { - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originRate": { - "$ref": "#/components/schemas/RateType" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "period": { - "$ref": "#/components/schemas/Period" - }, - "prinType": { - "$ref": "#/components/schemas/AmortPlan" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "LoanOriginalInfo" - ], - "type": "string" - } - }, - "required": [ - "originBalance", - "originRate", - "originTerm", - "period", - "startDate", - "prinType", - "tag" - ], - "title": "LoanOriginalInfo", - "type": "object" + "properties": { + "maturityDate": { + "$ref": "#/components/schemas/Day" }, - { - "properties": { - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originRental": { - "$ref": "#/components/schemas/LeaseRateCalc" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "LeaseInfo" - ], - "type": "string" - } - }, - "required": [ - "startDate", - "originTerm", - "originRental", - "tag" - ], - "title": "LeaseInfo", - "type": "object" + "originBalance": { + "multipleOf": 1.0e-2, + "type": "number" }, - { - "properties": { - "accRule": { - "$ref": "#/components/schemas/AmortRule" - }, - "capacity": { - "$ref": "#/components/schemas/Capacity" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "period": { - "$ref": "#/components/schemas/Period" - }, - "residualBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "FixedAssetInfo" - ], - "type": "string" - } - }, - "required": [ - "startDate", - "originBalance", - "residualBalance", - "originTerm", - "period", - "accRule", - "capacity", - "tag" - ], - "title": "FixedAssetInfo", - "type": "object" + "originDate": { + "$ref": "#/components/schemas/Day" }, - { - "properties": { - "dueDate": { - "$ref": "#/components/schemas/Day" - }, - "feeType": { - "$ref": "#/components/schemas/ReceivableFeeType" - }, - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originAdvance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "ReceivableInfo" - ], - "type": "string" - } - }, - "required": [ - "startDate", - "originBalance", - "originAdvance", - "dueDate", - "tag" - ], - "title": "ReceivableInfo", - "type": "object" + "originRate": { + "format": "double", + "type": "number" } - ] + }, + "required": [ + "originBalance", + "originDate", + "originRate" + ], + "type": "object" }, "PayOrderBy": { "oneOf": [ @@ -16515,24 +16167,114 @@ ], "title": "MaxSpreadToFaceReq", "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "items": [ + { + "$ref": "#/components/schemas/DealType" + }, + { + "$ref": "#/components/schemas/ApplyAssumptionType" + }, + { + "$ref": "#/components/schemas/NonPerfAssumption" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + { + "$ref": "#/components/schemas/RootFindTweak" + }, + { + "$ref": "#/components/schemas/RootFindStop" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + "tag": { + "enum": [ + "RFReq" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "RFReq", + "type": "object" } ] }, "RootFindResp": { + "items": [ + { + "format": "double", + "type": "number" + }, + { + "items": [ + { + "$ref": "#/components/schemas/DealType" + }, + { + "$ref": "#/components/schemas/ApplyAssumptionType" + }, + { + "$ref": "#/components/schemas/NonPerfAssumption" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "RootFindStop": { "oneOf": [ + { + "properties": { + "contents": { + "type": "string" + }, + "tag": { + "enum": [ + "BondIncurLoss" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondIncurLoss", + "type": "object" + }, { "properties": { "contents": { "items": [ { - "format": "double", - "type": "number" + "type": "string" }, { - "$ref": "#/components/schemas/ApplyAssumptionType" + "type": "boolean" }, { - "$ref": "#/components/schemas/RevolvingAssumption" + "type": "boolean" } ], "maxItems": 3, @@ -16541,7 +16283,7 @@ }, "tag": { "enum": [ - "FirstLossResult" + "BondPricingEqOriginBal" ], "type": "string" } @@ -16550,7 +16292,7 @@ "tag", "contents" ], - "title": "FirstLossResult", + "title": "BondPricingEqOriginBal", "type": "object" }, { @@ -16558,26 +16300,87 @@ "contents": { "items": [ { - "format": "double", - "type": "number" + "type": "string" }, { - "additionalProperties": { - "$ref": "#/components/schemas/Bond" - }, - "type": "object" + "multipleOf": 1.0e-6, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BondMetTargetIrr" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondMetTargetIrr", + "type": "object" + } + ] + }, + "RootFindTweak": { + "oneOf": [ + { + "properties": { + "tag": { + "enum": [ + "StressPoolDefault" + ], + "type": "string" + } + }, + "required": [ + "tag" + ], + "title": "StressPoolDefault", + "type": "object" + }, + { + "properties": { + "contents": { + "type": "string" + }, + "tag": { + "enum": [ + "MaxSpreadTo" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "MaxSpreadTo", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" }, { - "$ref": "#/components/schemas/DealType" + "type": "string" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 2, + "minItems": 2, "type": "array" }, "tag": { "enum": [ - "BestSpreadResult" + "SplitFixedBalance" ], "type": "string" } @@ -16586,7 +16389,7 @@ "tag", "contents" ], - "title": "BestSpreadResult", + "title": "SplitFixedBalance", "type": "object" } ] From e0d4725dda64c3eb3b17b0250c6977d9d33f1454 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sat, 7 Jun 2025 16:25:40 +0800 Subject: [PATCH 05/49] fix req header --- app/Main.hs | 16 ++++++------- swagger.json | 63 ++-------------------------------------------------- 2 files changed, 10 insertions(+), 69 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index f741b6ff..1a7e34b6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -367,13 +367,13 @@ evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_, else (fromRational . toRational) $ bondBal - v -evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) - = let - v = L.extractIrrResult $ pResult Map.! bn - in - case v of - Nothing -> -1 - Just irr -> (fromRational . toRational) $ irr - target +-- evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) +-- = let +-- v = L.extractIrrResult $ pResult Map.! bn +-- in +-- case v of +-- Nothing -> -1 +-- Just irr -> (fromRational . toRational) $ irr - target rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r @@ -385,7 +385,7 @@ rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r Left errorMsg -> -1 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) -runRootFinderBy (RFReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) tweak stop) +runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) tweak stop) = return $ let itertimes = 500 diff --git a/swagger.json b/swagger.json index c7d0b96a..ecb23584 100644 --- a/swagger.json +++ b/swagger.json @@ -16201,7 +16201,7 @@ }, "tag": { "enum": [ - "RFReq" + "RootFinderReq" ], "type": "string" } @@ -16210,7 +16210,7 @@ "tag", "contents" ], - "title": "RFReq", + "title": "RootFinderReq", "type": "object" } ] @@ -16294,36 +16294,6 @@ ], "title": "BondPricingEqOriginBal", "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "type": "string" - }, - { - "multipleOf": 1.0e-6, - "type": "number" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "BondMetTargetIrr" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "BondMetTargetIrr", - "type": "object" } ] }, @@ -16362,35 +16332,6 @@ ], "title": "MaxSpreadTo", "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "type": "string" - }, - { - "type": "string" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "SplitFixedBalance" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "SplitFixedBalance", - "type": "object" } ] }, From 24311e4b14069cf4e9f2298f29b0585bbfef3acb Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sat, 7 Jun 2025 18:12:41 +0800 Subject: [PATCH 06/49] workaround to aviod error: missing pricing assumption --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 1a7e34b6..ccd7a8fb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -359,8 +359,8 @@ evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_, otherBondOustanding False = 0.0 feeOutstanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealFeeMap dt) feeOutstanding False = 0.0 - v = getPriceValue $ pResult Map.! bn bondBal = L.getOriginBalance $ getDealBondMap dt Map.! bn + v = maybe bondBal getPriceValue $ Map.lookup bn pResult -- TODO shortcut to avoid error in if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0 then -1 From 0818aa9a1ae34ff1bb4e834d251ff41421e7dc33 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sat, 7 Jun 2025 19:16:11 +0800 Subject: [PATCH 07/49] bump version to-> < 0.46.1 > --- CHANGELOG.md | 6 ++++++ app/Main.hs | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0569783d..791da1fb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,12 @@ +## 0.46.1 +### 2025-06-07 +* ENHANCE: add 2 more `leaseEndType` assumptions: `Earlier` `Later` which will end the lease projection base on two input `End date` and `extention times`. +* ENHANCE: expose `new bond rate type` in `trigger effects`. Now bond rate type can be changed during the projection. +* REFACTOR: with new refactor `root finder` endpoint and signature. In the long term, the refactor of signature lays down fundation for `deal structuring` domain, now it would be easy to implement all kinds of structuring features. + ## 0.45.7 ### 2025-05-26 * ENHANCE: add `BaseByVec` for vector-based rental change diff --git a/app/Main.hs b/app/Main.hs index ccd7a8fb..24508b2d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -100,7 +100,7 @@ debug = flip Debug.Trace.trace version1 :: Version -version1 = Version "0.45.7" +version1 = Version "0.46.1" wrapRun :: DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp From cfc096163c1d0930d5a5962a34893315c5c300da Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sun, 8 Jun 2025 00:48:00 +0800 Subject: [PATCH 08/49] for structuring: slide balance --- app/Main.hs | 67 +++++++++++---------------------------------- app/MainBase.hs | 4 +-- src/Deal/DealMod.hs | 13 ++++++++- src/Liability.hs | 5 +++- 4 files changed, 34 insertions(+), 55 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 24508b2d..b8ccddde 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -290,49 +290,6 @@ getDealFeeMap (UDeal d) = DB.fees d getDealFeeMap (VDeal d) = DB.fees d getDealFeeMap (PDeal d) = DB.fees d --- stress the pool performance, till a bond suffers first loss -testByDefault :: DealType -> AP.ApplyAssumptionType -> AP.NonPerfAssumption -> BondName -> Double -> Double -testByDefault dt assumps nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving} bn r - = let - stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressAssetPerf (toRational r)) assumps - stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (toRational r) mRevolving } - runResult = wrapRun dt (Just stressed) stressedNonPerf -- `debug` ("running stress "++ show stressed) - in - case runResult of - Right (d,mPoolCfMap,mResult,mPricing) -> - let - bondBal = L.getOutstandingAmount $ (getDealBondMap d) Map.! bn - in - (fromRational (toRational bondBal) - 0.01) - Left errorMsg -> error $ "Error in test fun for first loss" ++ show errorMsg - - --- add spread to bonds till PV of bond (discounted by pricing assumption) equals to face value --- with constraint that all liabilities are paid off -testBySpread :: DealRunInput -> (BondName,Bool,Bool) -> Double -> Double -testBySpread (dt,mPAssump,runAssump) (bn,otherBondFlag,otherFeeFlag) f - = let - runResult = wrapRun (modifyDealType (DM.AddSpreadToBonds bn) f dt) mPAssump runAssump - in - case runResult of - Right (dt, mPoolCfMap, mResult, pResult) -> - let - -- bnds - otherBondsName = [] - -- check fees/other bonds - otherBondOustanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealBondMap dt) - otherBondOustanding False = 0.0 - feeOutstanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealFeeMap dt) - feeOutstanding False = 0.0 - v = getPriceValue $ pResult Map.! bn - bondBal = L.getOriginBalance $ (getDealBondMap dt) Map.! bn - in - if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0 then - -1 - else - (fromRational . toRational) $ bondBal - v - Left errorMsg -> error $ "Error in test fun for spread testing" ++ show errorMsg - doTweak :: Double -> RootFindTweak -> DealRunInput -> DealRunInput doTweak r StressPoolDefault (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) = let @@ -340,9 +297,14 @@ doTweak r StressPoolDefault (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumpti stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (toRational r) mRevolving } in (dt ,Just stressed, stressedNonPerf) + doTweak r (MaxSpreadTo bn) (dt , mAssump, rAssump) = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump) +doTweak r (SplitFixedBalance bn1 bn2) (dt , mAssump, rAssump) + = (modifyDealType (DM.SlideBalances bn1 bn2) r dt , mAssump, rAssump) + + evalRootFindStop :: RootFindStop -> RunRespRight -> Double evalRootFindStop (BondIncurLoss bn) (dt,_,_,_) = let @@ -367,13 +329,13 @@ evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_, else (fromRational . toRational) $ bondBal - v --- evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) --- = let --- v = L.extractIrrResult $ pResult Map.! bn --- in --- case v of --- Nothing -> -1 --- Just irr -> (fromRational . toRational) $ irr - target +evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) + = let + v = L.extractIrrResult $ pResult Map.! bn + in + case v of + Nothing -> -1 `debug` ("No IRR found for bond:"++ show bn) + Just irr -> (fromRational . toRational) $ irr - target `debug` ("IRR for bond:"++ show target ++" is "++ show irr) rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r @@ -390,8 +352,11 @@ runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssu let itertimes = 500 def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.0001} + riddersFn = case tweak of + SplitFixedBalance _ _ -> ridders def (0.99,0.01) + _ -> ridders def (500.0,0.00) -- default to 500.0,0.00 in - case ridders def (500.0,0.00) (rootFindAlgo req tweak stop) of + case riddersFn (rootFindAlgo req tweak stop) of Root r -> Right $ RFResult r (doTweak r tweak req) NotBracketed -> Left "Not able to bracket the root" SearchFailed -> Left "Not able to find the root" diff --git a/app/MainBase.hs b/app/MainBase.hs index f466c894..562a25a4 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -170,12 +170,12 @@ data RootFindReq = FirstLossReq DealRunInput BondName data RootFindTweak = StressPoolDefault -- stressed pool perf | MaxSpreadTo BondName -- bond component - -- | SplitFixedBalance (BondName,BondName) -- bond component + | SplitFixedBalance BondName BondName -- bond component deriving(Show, Generic) data RootFindStop = BondIncurLoss BondName | BondPricingEqOriginBal BondName Bool Bool - -- | BondMetTargetIrr BondName IRR + | BondMetTargetIrr BondName IRR deriving(Show, Generic) data RootFindResp = RFResult Double DealRunInput diff --git a/src/Deal/DealMod.hs b/src/Deal/DealMod.hs index 93ab679f..4a0754da 100644 --- a/src/Deal/DealMod.hs +++ b/src/Deal/DealMod.hs @@ -71,7 +71,7 @@ data AdjStrategy = ScaleBySpread deriving (Show,Generic) data ModifyType = AddSpreadToBonds BondName - | ScaleBondBalByRate + | SlideBalances BondName BondName deriving (Show,Generic) -- ^ Modify a deal by various type of recipes @@ -87,6 +87,17 @@ modDeal (AddSpreadToBonds bnd) sprd d bndMap in d {DB.bonds = bndMap'} + +modDeal (SlideBalances bn1 bn2) r d@DB.TestDeal {DB.bonds = bndMap} + = let + totalBalance = sum $ L.originBalance . L.bndOriginInfo <$> DB.viewDealBondsByNames d [bn1, bn2] + leftBal = mulBR totalBalance (toRational r) `debug` ("split ratio" ++ show r) + rightBal = totalBalance - leftBal + bndMap' = DB.updateBondInMap bn1 (L.adjustBalance leftBal) $ + DB.updateBondInMap bn2 (L.adjustBalance rightBal) bndMap `debug` ("leftBal: " ++ show leftBal ++ ", rightBal: " ++ show rightBal ) + in + d {DB.bonds = bndMap'} + modDeal x _ _ = error $ "modify deal: not implemented"++ show x diff --git a/src/Liability.hs b/src/Liability.hs index e5066f9f..cebe1320 100644 --- a/src/Liability.hs +++ b/src/Liability.hs @@ -20,7 +20,7 @@ module Liability ,getCurRate,bondCashflow,getOutstandingAmount,valueBond,getTxnRate ,getAccrueBegDate,getTxnInt,adjInterestInfoByRate,adjInterestInfoBySpread ,interestInfoTraversal,getOriginBalance,curRatesTraversal - ,backoutAccruedInt,extractIrrResult + ,backoutAccruedInt,extractIrrResult,adjustBalance ) where @@ -246,6 +246,9 @@ curRatesTraversal f (MultiIntBond bn bt oi iis sus bal rs dp dis diois did lips curRatesTraversal f (BondGroup bMap x) = BondGroup <$> traverse (curRatesTraversal f) bMap <*> pure x +adjustBalance :: Balance -> Bond -> Bond +adjustBalance bal b@Bond{bndBalance = _, bndOriginInfo = oi } + = b {bndBalance = bal, bndOriginInfo = oi {originBalance = bal}} bndmStmt :: Lens' Bond (Maybe S.Statement) bndmStmt = lens getter setter From b69eb3003b101098cc58cb3b678de1d2ddeab7f4 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sun, 8 Jun 2025 17:30:17 +0800 Subject: [PATCH 09/49] bump version to-> < 0.46.2 > --- app/Main.hs | 6 +++--- swagger.json | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 63 insertions(+), 4 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index b8ccddde..1819a23d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -100,7 +100,7 @@ debug = flip Debug.Trace.trace version1 :: Version -version1 = Version "0.46.1" +version1 = Version "0.46.2" wrapRun :: DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp @@ -334,8 +334,8 @@ evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) v = L.extractIrrResult $ pResult Map.! bn in case v of - Nothing -> -1 `debug` ("No IRR found for bond:"++ show bn) - Just irr -> (fromRational . toRational) $ irr - target `debug` ("IRR for bond:"++ show target ++" is "++ show irr) + Nothing -> -1 -- `debug` ("No IRR found for bond:"++ show bn) + Just irr -> (fromRational . toRational) $ irr - target -- `debug` ("IRR for bond:"++ show target ++" is "++ show irr) rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r diff --git a/swagger.json b/swagger.json index ecb23584..df3effe6 100644 --- a/swagger.json +++ b/swagger.json @@ -16294,6 +16294,36 @@ ], "title": "BondPricingEqOriginBal", "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "multipleOf": 1.0e-6, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BondMetTargetIrr" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondMetTargetIrr", + "type": "object" } ] }, @@ -16332,6 +16362,35 @@ ], "title": "MaxSpreadTo", "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "SplitFixedBalance" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "SplitFixedBalance", + "type": "object" } ] }, @@ -20577,7 +20636,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.45.7" + "version": "0.46.1" }, "openapi": "3.0.0", "paths": { From b1fdacee442e8941c67465aeaa86326d27638dad Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Mon, 9 Jun 2025 01:44:23 +0800 Subject: [PATCH 10/49] bump version to-> < 0.46.3 > --- CHANGELOG.md | 4 ++++ app/Main.hs | 2 +- src/Cashflow.hs | 1 + src/Deal/DealMod.hs | 4 ++-- swagger.json | 2 +- 5 files changed, 9 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 791da1fb..d1837fc5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ +## 0.46.2 +### 2025-06-08 +* ENHANCE: add `tweak`: `Balance Split` and `stop`: `Bond Met Target IRR` + ## 0.46.1 ### 2025-06-07 * ENHANCE: add 2 more `leaseEndType` assumptions: `Earlier` `Later` which will end the lease projection base on two input `End date` and `extention times`. diff --git a/app/Main.hs b/app/Main.hs index 1819a23d..f7fb60fb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -100,7 +100,7 @@ debug = flip Debug.Trace.trace version1 :: Version -version1 = Version "0.46.2" +version1 = Version "0.46.3" wrapRun :: DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp diff --git a/src/Cashflow.hs b/src/Cashflow.hs index 7ec52fa8..6d03ee44 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -745,6 +745,7 @@ tsSetRate _r (MortgageFlow a b c d e f g h i j k l) = MortgageFlow a b c d e f g tsSetRate _r (LoanFlow a b c d e f g i j k) = LoanFlow a b c d e f g i _r k tsSetRate _r (BondFlow a b c d) = BondFlow a b c d tsSetRate _r (ReceivableFlow a b c d e f g h i) = ReceivableFlow a b c d e f g h i +tsSetRate _r (LeaseFlow a b c d) = LeaseFlow a b c d tsSetRate _r (FixedFlow {} ) = error "Not implement set rate for FixedFlow" tsSetRate _ _ = error "Not implement set rate for this type" diff --git a/src/Deal/DealMod.hs b/src/Deal/DealMod.hs index 4a0754da..621ed47c 100644 --- a/src/Deal/DealMod.hs +++ b/src/Deal/DealMod.hs @@ -91,10 +91,10 @@ modDeal (AddSpreadToBonds bnd) sprd d modDeal (SlideBalances bn1 bn2) r d@DB.TestDeal {DB.bonds = bndMap} = let totalBalance = sum $ L.originBalance . L.bndOriginInfo <$> DB.viewDealBondsByNames d [bn1, bn2] - leftBal = mulBR totalBalance (toRational r) `debug` ("split ratio" ++ show r) + leftBal = mulBR totalBalance (toRational r) -- `debug` ("split ratio" ++ show r) rightBal = totalBalance - leftBal bndMap' = DB.updateBondInMap bn1 (L.adjustBalance leftBal) $ - DB.updateBondInMap bn2 (L.adjustBalance rightBal) bndMap `debug` ("leftBal: " ++ show leftBal ++ ", rightBal: " ++ show rightBal ) + DB.updateBondInMap bn2 (L.adjustBalance rightBal) bndMap -- `debug` ("leftBal: " ++ show leftBal ++ ", rightBal: " ++ show rightBal ) in d {DB.bonds = bndMap'} diff --git a/swagger.json b/swagger.json index df3effe6..9b9ede53 100644 --- a/swagger.json +++ b/swagger.json @@ -20636,7 +20636,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.46.1" + "version": "0.46.2" }, "openapi": "3.0.0", "paths": { From 973f61222dde430a869a099106cda1df450a33ab Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Tue, 10 Jun 2025 00:42:42 +0800 Subject: [PATCH 11/49] expose prepayment stress in root.finder --- app/Main.hs | 60 ++++++++++++++++++++++++++++++++++------------ app/MainBase.hs | 1 + src/Assumptions.hs | 10 +++++++- swagger.json | 17 ++++++++++++- 4 files changed, 71 insertions(+), 17 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index f7fb60fb..97d2a982 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -222,23 +222,45 @@ runDeal :: RunDealReq -> Handler RunResp runDeal (SingleRunReq dt assump nonPerfAssump) = return $ wrapRun dt assump nonPerfAssump -stressAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption -stressAssetPerf r (AP.MortgageAssump (Just da) mp mr ms) + +-- Stressing default assumption from AssetPerfAssumption +stressDefaultAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption +stressDefaultAssetPerf r (AP.MortgageAssump (Just da) mp mr ms) = AP.MortgageAssump (Just (AP.stressDefaultAssump r da)) mp mr ms -stressAssetPerf r (AP.LoanAssump (Just da) mp mr ms) +stressDefaultAssetPerf r (AP.LoanAssump (Just da) mp mr ms) = AP.LoanAssump (Just (AP.stressDefaultAssump r da)) mp mr ms -stressAssetPerf r (AP.InstallmentAssump (Just da) mp mr ms) +stressDefaultAssetPerf r (AP.InstallmentAssump (Just da) mp mr ms) = AP.InstallmentAssump (Just (AP.stressDefaultAssump r da)) mp mr ms -stressAssetPerf r (AP.ReceivableAssump (Just da) mr ms) +stressDefaultAssetPerf r (AP.ReceivableAssump (Just da) mr ms) = AP.ReceivableAssump (Just (AP.stressDefaultAssump r da)) mr ms -stressAssetPerf _ x = x - -stressRevovlingPerf :: Rate -> Maybe AP.RevolvingAssumption -> Maybe AP.RevolvingAssumption -stressRevovlingPerf r Nothing = Nothing -stressRevovlingPerf r (Just (AP.AvailableAssets rp applyAssumpType)) - = Just (AP.AvailableAssets rp (over (AP.applyAssumptionTypeAssetPerf . _1) (stressAssetPerf r) applyAssumpType)) -stressRevovlingPerf r (Just (AP.AvailableAssetsBy m)) - = Just (AP.AvailableAssetsBy (Map.map (over (_2 . AP.applyAssumptionTypeAssetPerf . _1) (stressAssetPerf r)) m)) +stressDefaultAssetPerf r (AP.LeaseAssump (Just (AP.DefaultByContinuation dr)) mg mr me) + = AP.LeaseAssump (Just (AP.DefaultByContinuation (min 1.0 dr * r))) mg mr me +stressDefaultAssetPerf r (AP.LeaseAssump (Just (AP.DefaultByTermination dr)) mg mr me) + = AP.LeaseAssump (Just (AP.DefaultByTermination (min 1.0 dr * r))) mg mr me +stressDefaultAssetPerf _ x = x + +-- Stressing prepayment assumption from AssetPerfAssumption +stressPrepayAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption +stressPrepayAssetPerf r (AP.MortgageAssump da (Just mp) mr ms) + = AP.MortgageAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf r (AP.MortgageDeqAssump da (Just mp) mr ms) + = AP.MortgageDeqAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf r (AP.LoanAssump da (Just mp) mr ms) + = AP.LoanAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf r (AP.InstallmentAssump da (Just mp) mr ms) + = AP.InstallmentAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf _ x = x + + + + +-- Stressing default assumption +stressRevovlingPerf :: (AP.AssetPerfAssumption -> AP.AssetPerfAssumption)-> Maybe AP.RevolvingAssumption -> Maybe AP.RevolvingAssumption +stressRevovlingPerf f Nothing = Nothing +stressRevovlingPerf f (Just (AP.AvailableAssets rp applyAssumpType)) + = Just (AP.AvailableAssets rp (over (AP.applyAssumptionTypeAssetPerf . _1) f applyAssumpType)) +stressRevovlingPerf f (Just (AP.AvailableAssetsBy m)) + = Just (AP.AvailableAssetsBy (Map.map (over (_2 . AP.applyAssumptionTypeAssetPerf . _1) f) m)) modifyDealType :: DM.ModifyType -> Double -> DealType -> DealType modifyDealType dm f (MDeal d) = MDeal $ DM.modDeal dm f d @@ -293,11 +315,19 @@ getDealFeeMap (PDeal d) = DB.fees d doTweak :: Double -> RootFindTweak -> DealRunInput -> DealRunInput doTweak r StressPoolDefault (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) = let - stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressAssetPerf (toRational r)) assumps - stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (toRational r) mRevolving } + stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressDefaultAssetPerf (toRational r)) assumps + stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressDefaultAssetPerf (toRational r)) mRevolving } in (dt ,Just stressed, stressedNonPerf) +doTweak r StressPoolPrepayment (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) + = let + stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressPrepayAssetPerf (toRational r)) assumps + stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressPrepayAssetPerf (toRational r)) mRevolving } + in + (dt ,Just stressed, stressedNonPerf) + + doTweak r (MaxSpreadTo bn) (dt , mAssump, rAssump) = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump) diff --git a/app/MainBase.hs b/app/MainBase.hs index 562a25a4..05b3600f 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -169,6 +169,7 @@ data RootFindReq = FirstLossReq DealRunInput BondName deriving(Show, Generic) data RootFindTweak = StressPoolDefault -- stressed pool perf + | StressPoolPrepayment -- stressed pool prepayment | MaxSpreadTo BondName -- bond component | SplitFixedBalance BondName BondName -- bond component deriving(Show, Generic) diff --git a/src/Assumptions.hs b/src/Assumptions.hs index 71813ca2..081d8807 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -21,7 +21,7 @@ module Assumptions (BondPricingInput(..),IrrType(..) ,_MortgageAssump,_MortgageDeqAssump,_LeaseAssump,_LoanAssump,_InstallmentAssump ,_ReceivableAssump,_FixedAssetAssump ,stressDefaultAssump,applyAssumptionTypeAssetPerf,TradeType(..) - ,LeaseEndType(..),LeaseDefaultType(..) + ,LeaseEndType(..),LeaseDefaultType(..),stressPrepaymentAssump ) where @@ -167,6 +167,14 @@ stressDefaultAssump x (DefaultAtEndByRate r1 r2) = DefaultAtEndByRate (min 1.0 ( stressDefaultAssump x (DefaultByTerm rss) = DefaultByTerm $ ((capWith 1.0) <$> (map (map (* x)) rss)) stressDefaultAssump x (DefaultStressByTs ts a) = DefaultStressByTs ts (stressDefaultAssump x a) +stressPrepaymentAssump :: Rate -> AssetPrepayAssumption -> AssetPrepayAssumption +stressPrepaymentAssump x (PrepaymentConstant r) = PrepaymentConstant $ min 1.0 (r*x) +stressPrepaymentAssump x (PrepaymentCPR r) = PrepaymentCPR $ min 1.0 (r*x) +stressPrepaymentAssump x (PrepaymentVec rs) = PrepaymentVec $ capWith 1.0 ((x*) <$> rs) +stressPrepaymentAssump x (PrepaymentVecPadding rs) = PrepaymentVecPadding $ capWith 1.0 ((x*) <$> rs) +stressPrepaymentAssump x (PrepayByAmt (b,rs)) = PrepayByAmt (mulBR b x, rs) +stressPrepaymentAssump x (PrepayStressByTs ts a) = PrepayStressByTs ts (stressPrepaymentAssump x a) + data AssetPrepayAssumption = PrepaymentConstant Rate | PrepaymentCPR Rate diff --git a/swagger.json b/swagger.json index 9b9ede53..f538a849 100644 --- a/swagger.json +++ b/swagger.json @@ -16344,6 +16344,21 @@ "title": "StressPoolDefault", "type": "object" }, + { + "properties": { + "tag": { + "enum": [ + "StressPoolPrepayment" + ], + "type": "string" + } + }, + "required": [ + "tag" + ], + "title": "StressPoolPrepayment", + "type": "object" + }, { "properties": { "contents": { @@ -20636,7 +20651,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.46.2" + "version": "0.46.3" }, "openapi": "3.0.0", "paths": { From e1f90ffa83d153d6ac96924a9716eff6c6ef0911 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Tue, 10 Jun 2025 13:51:06 +0800 Subject: [PATCH 12/49] extend stress prepayment --- src/Assumptions.hs | 4 +++- src/Deal/DealBase.hs | 10 ---------- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/src/Assumptions.hs b/src/Assumptions.hs index 081d8807..a68cf7b3 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -164,8 +164,8 @@ stressDefaultAssump x (DefaultVec rs) = DefaultVec $ capWith 1.0 ((x*) <$> rs) stressDefaultAssump x (DefaultVecPadding rs) = DefaultVecPadding $ capWith 1.0 ((x*) <$> rs) stressDefaultAssump x (DefaultByAmt (b,rs)) = DefaultByAmt (mulBR b x, rs) stressDefaultAssump x (DefaultAtEndByRate r1 r2) = DefaultAtEndByRate (min 1.0 (r1*x)) (min 1.0 (r2*x)) -stressDefaultAssump x (DefaultByTerm rss) = DefaultByTerm $ ((capWith 1.0) <$> (map (map (* x)) rss)) stressDefaultAssump x (DefaultStressByTs ts a) = DefaultStressByTs ts (stressDefaultAssump x a) +stressDefaultAssump x (DefaultByTerm rss) = DefaultByTerm $ ((capWith 1.0) <$> (map (map (* x)) rss)) stressPrepaymentAssump :: Rate -> AssetPrepayAssumption -> AssetPrepayAssumption stressPrepaymentAssump x (PrepaymentConstant r) = PrepaymentConstant $ min 1.0 (r*x) @@ -174,6 +174,8 @@ stressPrepaymentAssump x (PrepaymentVec rs) = PrepaymentVec $ capWith 1.0 ((x*) stressPrepaymentAssump x (PrepaymentVecPadding rs) = PrepaymentVecPadding $ capWith 1.0 ((x*) <$> rs) stressPrepaymentAssump x (PrepayByAmt (b,rs)) = PrepayByAmt (mulBR b x, rs) stressPrepaymentAssump x (PrepayStressByTs ts a) = PrepayStressByTs ts (stressPrepaymentAssump x a) +stressPrepaymentAssump x (PrepaymentPSA r) = PrepaymentPSA $ min 1.0 (r*x) +stressPrepaymentAssump x (PrepaymentByTerm rss) = PrepaymentByTerm $ (capWith 1.0 <$> (map (map (* x)) rss)) data AssetPrepayAssumption = PrepaymentConstant Rate diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index e010e076..823d441a 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -484,16 +484,6 @@ updateBondInMap bName f bMap in Map.mapWithKey fn bMap --- updateBondInMap' :: BondName -> (L.Bond -> Either String L.Bond) -> Map.Map BondName L.Bond -> Either String (Map.Map BondName L.Bond) --- updateBondInMap' bName f bMap --- = let --- fn _bName (L.BondGroup subMap bt) = L.BondGroup (Map.adjust f _bName subMap) bt --- fn _bName bnd --- | _bName == bName = f bnd --- | otherwise = Right bnd --- in --- traverse fn bMap - dealAccounts :: Ast.Asset a => Lens' (TestDeal a) (Map.Map AccountName A.Account) dealAccounts = lens getter setter where From 2854f92d21013d83c5db077ba054bbaa8615e355 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Tue, 10 Jun 2025 16:22:59 +0800 Subject: [PATCH 13/49] expose stop: bondPrinLoss bondIntLoss --- app/Main.hs | 15 ++++++++++++- app/MainBase.hs | 2 ++ swagger.json | 60 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 76 insertions(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 97d2a982..8256c40d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -342,6 +342,19 @@ evalRootFindStop (BondIncurLoss bn) (dt,_,_,_) in (fromRational . toRational) $ bondBal - 0.01 +evalRootFindStop (BondIncurIntLoss bn threshold) (dt,_,_,_) + = let + dueIntAmt = L.getTotalDueInt $ getDealBondMap dt Map.! bn + in + (fromRational . toRational) $ threshold - (dueIntAmt-0.01) + +evalRootFindStop (BondIncurPrinLoss bn threshold) (dt,_,_,_) + = let + duePrinAmt = L.getCurBalance $ getDealBondMap dt Map.! bn + in + (fromRational . toRational) $ threshold - (duePrinAmt-0.01) + + evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_,pResult) = let -- bnds @@ -373,7 +386,7 @@ rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r (dt' ,poolAssumps', runAssumps') = doTweak r tweak (dt ,poolAssumps, runAssumps) in case wrapRun dt' poolAssumps' runAssumps' of - Right runRespRight -> evalRootFindStop stop runRespRight + Right runRespRight -> evalRootFindStop stop runRespRight `debug` ("Begin pool"++ show poolAssumps') Left errorMsg -> -1 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) diff --git a/app/MainBase.hs b/app/MainBase.hs index 05b3600f..8f85bac1 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -175,6 +175,8 @@ data RootFindTweak = StressPoolDefault -- stressed pool perf deriving(Show, Generic) data RootFindStop = BondIncurLoss BondName + | BondIncurPrinLoss BondName Balance + | BondIncurIntLoss BondName Balance | BondPricingEqOriginBal BondName Bool Bool | BondMetTargetIrr BondName IRR deriving(Show, Generic) diff --git a/swagger.json b/swagger.json index f538a849..d9a67299 100644 --- a/swagger.json +++ b/swagger.json @@ -16263,6 +16263,66 @@ "title": "BondIncurLoss", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BondIncurPrinLoss" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondIncurPrinLoss", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BondIncurIntLoss" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondIncurIntLoss", + "type": "object" + }, { "properties": { "contents": { From 303b5218664c3ccfe01154823f42d6d87f1405a6 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Tue, 10 Jun 2025 17:17:56 +0800 Subject: [PATCH 14/49] bump version to-> < 0.46.4 > --- app/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 8256c40d..44f2a298 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -100,7 +100,7 @@ debug = flip Debug.Trace.trace version1 :: Version -version1 = Version "0.46.3" +version1 = Version "0.46.4" wrapRun :: DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp @@ -386,7 +386,7 @@ rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r (dt' ,poolAssumps', runAssumps') = doTweak r tweak (dt ,poolAssumps, runAssumps) in case wrapRun dt' poolAssumps' runAssumps' of - Right runRespRight -> evalRootFindStop stop runRespRight `debug` ("Begin pool"++ show poolAssumps') + Right runRespRight -> evalRootFindStop stop runRespRight -- `debug` ("Begin pool"++ show poolAssumps') Left errorMsg -> -1 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) From aca49c92405b9edcf42ac28e4453128a313246fb Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Tue, 10 Jun 2025 18:05:37 +0800 Subject: [PATCH 15/49] add throw error on IRR of bond --- CHANGELOG.md | 7 +++++++ src/Analytics.hs | 5 +++-- src/Assumptions.hs | 8 +------- swagger.json | 2 +- 4 files changed, 12 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d1837fc5..7dca49e3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,13 @@ +## 0.46.4 +### 2025-06-10 + +* ENHANCE: add `tweak`: `Stress Prepayment` +* ENHANCE: add `stop`: `Bond Principal Loss` `Bond Interest Loss` + + ## 0.46.2 ### 2025-06-08 * ENHANCE: add `tweak`: `Balance Split` and `stop`: `Bond Met Target IRR` diff --git a/src/Analytics.hs b/src/Analytics.hs index 3a86ab5e..30d85644 100644 --- a/src/Analytics.hs +++ b/src/Analytics.hs @@ -163,8 +163,9 @@ calcIRR :: [Date] -> [Amount] -> Either String Rate calcIRR _ [] = Left "No cashflow amount" calcIRR [] _ = Left "No cashflow date" calcIRR ds vs - | all (> 0) vs = Left "All cashflow can't be all positive" - | all (< 0) vs = Left "All cashflow can't be all negative" + | all (>= 0) vs = Left $ "All cashflow can't be all positive:"++ show vs + | all (<= 0) vs = Left $ "All cashflow can't be all negative:"++ show vs + | all (== 0) vs = Left "All cashflow can't be all zeros" | otherwise = let itertimes = 1000 diff --git a/src/Assumptions.hs b/src/Assumptions.hs index a68cf7b3..a54e560b 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -15,7 +15,7 @@ module Assumptions (BondPricingInput(..),IrrType(..) ,NonPerfAssumption(..),AssetPerf ,AssetDelinquencyAssumption(..) ,AssetDelinqPerfAssumption(..),AssetDefaultedPerfAssumption(..) - ,calcResetDates,IssueBondEvent(..) + ,IssueBondEvent(..) ,TagMatchRule(..),ObligorStrategy(..),RefiEvent(..),InspectType(..) ,FieldMatchRule(..),CallOpt(..) ,_MortgageAssump,_MortgageDeqAssump,_LeaseAssump,_LoanAssump,_InstallmentAssump @@ -334,12 +334,6 @@ projRates _ rt rassump ds = Left ("Invalid rate type: "++ show rt++" assump: "++ -- ^ Given a list of rates, calcualte whether rates was reset -calcResetDates :: [IRate] -> [Bool] -> [Bool] -calcResetDates [] bs = bs -calcResetDates (r:rs) bs - | null rs = calcResetDates [] (False:bs) - | r == head rs = calcResetDates rs (bs++[False]) - | otherwise = calcResetDates rs (bs++[True]) makePrisms ''AssetPerfAssumption makePrisms ''AssetDefaultAssumption diff --git a/swagger.json b/swagger.json index d9a67299..14e0a715 100644 --- a/swagger.json +++ b/swagger.json @@ -20711,7 +20711,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.46.3" + "version": "0.46.4" }, "openapi": "3.0.0", "paths": { From 9a0ff13202624fa3858a2fb6a48b185c761ef4bf Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Wed, 11 Jun 2025 13:40:15 +0800 Subject: [PATCH 16/49] Fix: Report with Lease Asset --- src/Cashflow.hs | 1 + src/Stmt.hs | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Cashflow.hs b/src/Cashflow.hs index 6d03ee44..9a4ce03f 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -597,6 +597,7 @@ mflowRecovery (MortgageDelinqFlow _ _ _ _ _ _ _ x _ _ _ _ _) = x mflowRecovery (LoanFlow _ _ _ _ _ _ x _ _ _) = x mflowRecovery FixedFlow {} = 0 mflowRecovery (ReceivableFlow _ _ _ _ _ _ x _ _ ) = x +mflowRecovery (LeaseFlow _ _ _ _) = 0 mflowRecovery _ = error "not supported" tsRowBalance :: Lens' TsRow Balance diff --git a/src/Stmt.hs b/src/Stmt.hs index 61094b87..fb334724 100644 --- a/src/Stmt.hs +++ b/src/Stmt.hs @@ -207,10 +207,10 @@ 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]) -data FlowDirection = Inflow - | Outflow - | Interflow - | Noneflow +data FlowDirection = Inflow -- cash flow into the SPV + | Outflow -- cash flow out of the SPV + | Interflow -- cash flow within the SPV + | Noneflow -- no cash flow deriving (Eq,Show,Generic) getFlow :: TxnComment -> FlowDirection @@ -229,7 +229,7 @@ getFlow comment = SwapOutSettle _ -> Outflow PurchaseAsset _ _-> Outflow Transfer _ _ -> Interflow - TransferBy _ _ _ -> Interflow + TransferBy {} -> Interflow FundWith _ _ -> Inflow PoolInflow _ _ -> Inflow LiquidationProceeds _ -> Inflow From 17e9b1143b35f04556823b095a2ced04aaa15eb3 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Wed, 18 Jun 2025 14:08:18 +0800 Subject: [PATCH 17/49] expose StopByPre --- src/Assumptions.hs | 16 +++++++++++----- src/Deal.hs | 19 +++++++++++++++---- src/Deal/DealBase.hs | 2 ++ src/InterestRate.hs | 5 ++++- 4 files changed, 32 insertions(+), 10 deletions(-) diff --git a/src/Assumptions.hs b/src/Assumptions.hs index a54e560b..fefb6c53 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -21,7 +21,7 @@ module Assumptions (BondPricingInput(..),IrrType(..) ,_MortgageAssump,_MortgageDeqAssump,_LeaseAssump,_LoanAssump,_InstallmentAssump ,_ReceivableAssump,_FixedAssetAssump ,stressDefaultAssump,applyAssumptionTypeAssetPerf,TradeType(..) - ,LeaseEndType(..),LeaseDefaultType(..),stressPrepaymentAssump + ,LeaseEndType(..),LeaseDefaultType(..),stressPrepaymentAssump,StopBy(..) ) where @@ -126,8 +126,14 @@ data CallOpt = LegacyOpts [C.CallOption] -- ^ legacy support | CallOnDates DatePattern [Pre] -- ^ test call at end of day deriving (Show, Generic, Read, Ord, Eq) +data StopBy = StopByDate Date -- ^ stop by date + | StopByPre DatePattern [Pre] -- ^ stop by precondition + deriving (Show, Generic, Read) + + data NonPerfAssumption = NonPerfAssumption { - stopRunBy :: Maybe Date -- ^ optional stop day,which will stop cashflow projection + -- stopRunBy :: Maybe Date -- ^ optional stop day,which will stop cashflow projection + stopRunBy :: Maybe StopBy -- ^ optional stop day,which will stop cashflow projection ,projectedExpense :: Maybe [(FeeName,Ts)] -- ^ optional expense projection ,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 @@ -256,8 +262,8 @@ type AmountToBuy = Balance data TradeType = ByCash Balance - | ByBalance Balance - deriving (Show,Generic) + | ByBalance Balance + deriving (Show,Generic) data IrrType = HoldingBond HistoryCash CurrentHolding (Maybe (Date, BondPricingMethod)) | BuyBond Date BondPricingMethod TradeType (Maybe (Date, BondPricingMethod)) @@ -347,7 +353,7 @@ $(deriveJSON defaultOptions ''RefiEvent) -$(concat <$> traverse (deriveJSON defaultOptions) [''LeaseDefaultType, ''LeaseEndType,''FieldMatchRule,''TagMatchRule, ''ObligorStrategy,''ApplyAssumptionType, ''AssetPerfAssumption +$(concat <$> traverse (deriveJSON defaultOptions) [''LeaseDefaultType, ''LeaseEndType,''FieldMatchRule,''TagMatchRule, ''ObligorStrategy,''ApplyAssumptionType, ''AssetPerfAssumption, ''StopBy , ''AssetDefaultedPerfAssumption, ''AssetDelinqPerfAssumption, ''NonPerfAssumption, ''AssetDefaultAssumption , ''AssetPrepayAssumption, ''RecoveryAssumption, ''ExtraStress , ''LeaseAssetGapAssump, ''LeaseAssetRentAssump, ''RevolvingAssumption, ''AssetDelinquencyAssumption,''InspectType]) diff --git a/src/Deal.hs b/src/Deal.hs index 048144ae..2e4404af 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -806,6 +806,14 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= return (prepareDeal dealAfterCleanUp, DL.snoc (endingLogs `DL.append` newStLogs) (EndRun (Just d) "Clean Up")) -- `debug` ("Called ! "++ show d) _ -> run t poolFlowMap (Just ads) rates calls rAssump log + StopRunTest d pres -> + do + flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- pres ] + case any id flags of + True -> Right (prepareDeal t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show pres))) + _ -> run t poolFlowMap (Just ads) rates calls rAssump log + + _ -> Left $ "Failed to match action on Date"++ show ad where @@ -1418,12 +1426,15 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s Just AP.NonPerfAssumption{AP.callWhen = Just callOpts} -> concat [ extractTestDates callOpt | callOpt <- callOpts ] _ -> [] - + let stopTestDates = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.stopRunBy = Just (AP.StopByPre dp pres)} + -> [StopRunTest d pres | d <- genSerialDatesTill2 EI startDate dp endDate] + _ -> [] let allActionDates = let __actionDates = let a = concat [bActionDates,pActionDates,custWdates,iAccIntDates,makeWholeDate ,feeAccrueDates,liqResetDates,mannualTrigger,concat rateCapSettleDates - ,concat irUpdateSwapDates, concat irSettleSwapDates ,inspectDates, bndRateResets,financialRptDates + ,concat irUpdateSwapDates, concat irSettleSwapDates ,inspectDates, bndRateResets,financialRptDates, stopTestDates ,bondIssuePlan,bondRefiPlan,callDates, iAccRateResetDates ,bndStepUpDates] in @@ -1433,7 +1444,7 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s _actionDates = __actionDates++[HitStatedMaturity endDate] in case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.stopRunBy = Just d} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d] + Just AP.NonPerfAssumption{AP.stopRunBy = Just (AP.StopByDate d)} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d] _ -> _actionDates let newFeeMap = case mNonPerfAssump of @@ -1534,4 +1545,4 @@ depositPoolFlow rules d pFlowMap amap -- = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules = foldM (\acc rule -> depositInflow d rule pFlowMap acc) amap rules -$(deriveJSON defaultOptions ''ExpectReturn) \ No newline at end of file +$(deriveJSON defaultOptions ''ExpectReturn) diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index 823d441a..7080db1c 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -106,6 +106,7 @@ data ActionOnDate = EarnAccInt Date AccName -- ^ sweep bank account | RefiBond Date AccountName L.Bond | BuildReport StartDate EndDate -- ^ build cashflow report between dates and balance report at end date | StopRunFlag Date -- ^ stop the run with a message + | StopRunTest Date [Pre] -- ^ stop the run with a condition | HitStatedMaturity Date -- ^ hit the stated maturity date | TestCall Date -- ^ test call dates deriving (Show,Generic,Read) @@ -142,6 +143,7 @@ instance TimeSeries ActionOnDate where getDate (TestCall d) = d getDate (FundBond d _ _ _ _) = d getDate (HitStatedMaturity d) = d + getDate (StopRunTest d _) = d getDate x = error $ "Failed to match"++ show x diff --git a/src/InterestRate.hs b/src/InterestRate.hs index 47418a30..18f632aa 100644 --- a/src/InterestRate.hs +++ b/src/InterestRate.hs @@ -5,7 +5,7 @@ module InterestRate (ARM(..),RateType(..),runInterestRate2,runInterestRate,UseRate(..) - ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve) + ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve, getSpread) where @@ -43,6 +43,9 @@ getDayCount :: RateType -> DayCount getDayCount (Fix dc _) = dc getDayCount (Floater dc _ _ _ _ _ _ _ ) = dc +getSpread :: RateType -> Maybe Spread +getSpread (Fix _ _) = Nothing +getSpread (Floater _ _ spd _ _ _ _ _) = Just spd data ARM = ARM InitPeriod InitCap PeriodicCap LifetimeCap RateFloor | OtherARM From 30938ba6a718a20fa55f6eabbe21f87efa758e1a Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Wed, 18 Jun 2025 21:04:31 +0800 Subject: [PATCH 18/49] stopBy: any to all --- CHANGELOG.md | 2 +- Hastructure.cabal | 1 + app/Main.hs | 1 - app/MainBase.hs | 1 + src/Deal.hs | 10 ++++----- swagger.json | 57 ++++++++++++++++++++++++++++++++++++++++++++++- 6 files changed, 64 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7dca49e3..49d2db0d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,7 @@ ## 0.46.4 ### 2025-06-10 - +* ENHANCE: add error message when calculation IRR for bond with non cashflow * ENHANCE: add `tweak`: `Stress Prepayment` * ENHANCE: add `stop`: `Bond Principal Loss` `Bond Interest Loss` diff --git a/Hastructure.cabal b/Hastructure.cabal index 9937f210..7dca04da 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -6,6 +6,7 @@ cabal-version: 3.0 name: Hastructure version: 0.45.0 +synopsis: Cashflow modeling library for structured finance description: Please see the README on GitHub at category: StructuredFinance;Securitisation;Cashflow homepage: https://github.com/yellowbean/Hastructure#readme diff --git a/app/Main.hs b/app/Main.hs index 44f2a298..2ef722c5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -327,7 +327,6 @@ doTweak r StressPoolPrepayment (dt , Just assumps, nonPerfAssump@AP.NonPerfAssum in (dt ,Just stressed, stressedNonPerf) - doTweak r (MaxSpreadTo bn) (dt , mAssump, rAssump) = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump) diff --git a/app/MainBase.hs b/app/MainBase.hs index 8f85bac1..b85c8f06 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -289,6 +289,7 @@ instance ToSchema (TsPoint AP.RefiEvent) instance ToSchema AP.RefiEvent instance ToSchema AP.InspectType instance ToSchema AP.CallOpt +instance ToSchema AP.StopBy instance ToSchema AP.NonPerfAssumption instance ToSchema BondPricingMethod instance ToSchema AP.TradeType diff --git a/src/Deal.hs b/src/Deal.hs index 2e4404af..c6b592ae 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -807,11 +807,11 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= _ -> run t poolFlowMap (Just ads) rates calls rAssump log StopRunTest d pres -> - do - flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- pres ] - case any id flags of - True -> Right (prepareDeal t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show pres))) - _ -> run t poolFlowMap (Just ads) rates calls rAssump log + do + flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- pres ] + case all id flags of + True -> Right (prepareDeal t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags)))) + _ -> run t poolFlowMap (Just ads) rates calls rAssump log _ -> Left $ "Failed to match action on Date"++ show ad diff --git a/swagger.json b/swagger.json index 14e0a715..f0baaf43 100644 --- a/swagger.json +++ b/swagger.json @@ -11739,7 +11739,7 @@ "$ref": "#/components/schemas/RevolvingAssumption" }, "stopRunBy": { - "$ref": "#/components/schemas/Day" + "$ref": "#/components/schemas/StopBy" } }, "type": "object" @@ -16971,6 +16971,61 @@ } ] }, + "StopBy": { + "oneOf": [ + { + "properties": { + "contents": { + "$ref": "#/components/schemas/Day" + }, + "tag": { + "enum": [ + "StopByDate" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "StopByDate", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/DatePattern" + }, + { + "items": { + "$ref": "#/components/schemas/Pre" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "StopByPre" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "StopByPre", + "type": "object" + } + ] + }, "Table_(Fixed_*_E2)_(Fixed_*_E2)": { "items": { "items": [ From 4b5fae774f6512d368203db196a6ecceddb09fdd Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 30 Jun 2025 21:31:47 +0800 Subject: [PATCH 19/49] Init for loan level testing --- app/Main.hs | 144 +++++---- app/MainBase.hs | 25 +- src/Asset.hs | 4 +- src/AssetClass/AssetBase.hs | 10 - src/Assumptions.hs | 2 +- src/Cashflow.hs | 46 ++- src/Deal.hs | 382 +++++++++++++---------- src/Deal/DealAction.hs | 25 +- src/Deal/DealBase.hs | 175 ++++++----- src/Deal/DealQuery.hs | 66 ++-- src/InterestRate.hs | 10 +- src/Pool.hs | 72 ++--- src/Types.hs | 38 ++- swagger.json | 474 ++++++++++++++++++++++++----- test/DealTest/DealTest.hs | 4 +- test/DealTest/MultiPoolDealTest.hs | 6 +- test/DealTest/ResecDealTest.hs | 4 +- test/DealTest/RevolvingTest.hs | 6 +- test/UT/AccountTest.hs | 2 +- test/UT/AssetTest.hs | 6 +- test/UT/DealTest.hs | 11 +- test/UT/DealTest2.hs | 2 +- 22 files changed, 964 insertions(+), 550 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 2ef722c5..ca76d474 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -32,6 +32,7 @@ import Data.Attoparsec.ByteString import Data.ByteString (ByteString) import Data.List import Data.Map +import qualified Data.Set as S import Data.Proxy import qualified Data.Text as T import Data.Maybe @@ -103,75 +104,74 @@ version1 :: Version version1 = Version "0.46.4" -wrapRun :: DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp -wrapRun (MDeal d) mAssump mNonPerfAssump +wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp +wrapRun fs (MDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (MDeal _d,_pflow,_rs,_p) -- `debug` ("Run Done with deal->"++ show _d) -wrapRun (RDeal d) mAssump mNonPerfAssump +wrapRun fs (RDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (RDeal _d,_pflow,_rs,_p) -wrapRun (IDeal d) mAssump mNonPerfAssump +wrapRun fs (IDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (IDeal _d,_pflow,_rs,_p) -wrapRun (LDeal d) mAssump mNonPerfAssump +wrapRun fs (LDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (LDeal _d,_pflow,_rs,_p) -wrapRun (FDeal d) mAssump mNonPerfAssump +wrapRun fs (FDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (FDeal _d,_pflow,_rs,_p) -wrapRun (UDeal d) mAssump mNonPerfAssump +wrapRun fs (UDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (UDeal _d,_pflow,_rs,_p) -wrapRun (VDeal d) mAssump mNonPerfAssump +wrapRun fs (VDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (VDeal _d,_pflow,_rs,_p) -wrapRun (PDeal d) mAssump mNonPerfAssump +wrapRun fs (PDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump + (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump return (PDeal _d,_pflow,_rs,_p) -wrapRun x _ _ = Left $ "RunDeal Failed ,due to unsupport deal type "++ show x +wrapRun _ x _ _ = Left $ "RunDeal Failed ,due to unsupport deal type "++ show x patchCumulativeToPoolRun :: RunPoolTypeRtn_ -> RunPoolTypeRtn_ patchCumulativeToPoolRun = Map.map - (\(CF.CashFlowFrame _ txns,stats) -> - (CF.CashFlowFrame (0,Lib.toDate "19000101",Nothing) (CF.patchCumulative (0,0,0,0,0,0) [] txns),stats)) + (\(CF.CashFlowFrame _ txns,mAssetFlow) -> + (CF.CashFlowFrame (0,Lib.toDate "19000101",Nothing) (CF.patchCumulative (0,0,0,0,0,0) [] txns),mAssetFlow)) -wrapRunPoolType :: PoolTypeWrap -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] -> RunPoolTypeRtn -wrapRunPoolType (MPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (LPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (IPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (RPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (FPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (VPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (PPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (UPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType x _ _ = Left $ "RunPool Failed ,due to unsupport pool type "++ show x +wrapRunPoolType :: Bool -> PoolTypeWrap -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] -> RunPoolTypeRtn +wrapRunPoolType flag (MPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (LPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (IPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (RPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (FPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (VPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (PPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (UPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag x _ _ = Left $ "RunPool Failed ,due to unsupport pool type "++ show x wrapRunAsset :: RunAssetReq -> RunAssetResp wrapRunAsset (RunAssetReq d assets Nothing mRates Nothing) = do cfs <- sequenceA $ (\a -> MA.calcAssetUnion a d mRates) <$> assets - return (P.aggPool Nothing [(cf,Map.empty) | cf <- cfs], Nothing) + return (fst (P.aggPool Nothing [(cf,Map.empty) | cf <- cfs]), Nothing) wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates Nothing) = do cfs <- sequenceA $ (\a -> MA.projAssetUnion a d assumps mRates) <$> assets - return (P.aggPool Nothing [(cf,Map.empty) | (cf,_) <- cfs] , Nothing) + return (fst (P.aggPool Nothing [(cf,Map.empty) | (cf,_) <- cfs]) , Nothing) wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates (Just pm)) - = - do + = do cfs <- sequenceA $ (\a -> MA.projAssetUnion a d assumps mRates) <$> assets pricingResult <- sequenceA $ (\a -> D.priceAssetUnion a d pm assumps mRates) <$> assets - let assetCf = P.aggPool Nothing cfs + let (assetCf,_) = P.aggPool Nothing cfs return (assetCf , Just pricingResult) -- Swagger API @@ -208,19 +208,18 @@ runAsset :: RunAssetReq -> Handler RunAssetResp runAsset req = return $ wrapRunAsset req runPool :: RunPoolReq -> Handler PoolRunResp -runPool (SingleRunPoolReq pt passumption mRates) +runPool (SingleRunPoolReq f pt passumption mRates) = return $ - patchCumulativeToPoolRun <$> (wrapRunPoolType pt passumption mRates) + patchCumulativeToPoolRun <$> (wrapRunPoolType f pt passumption mRates) runPoolScenarios :: RunPoolReq -> Handler (Map.Map ScenarioName PoolRunResp) -runPoolScenarios (MultiScenarioRunPoolReq pt mAssumps mRates) +runPoolScenarios (MultiScenarioRunPoolReq f pt mAssumps mRates) = return $ Map.map (\assump -> - patchCumulativeToPoolRun <$> (wrapRunPoolType pt (Just assump) mRates)) + patchCumulativeToPoolRun <$> (wrapRunPoolType f pt (Just assump) mRates)) mAssumps runDeal :: RunDealReq -> Handler RunResp -runDeal (SingleRunReq dt assump nonPerfAssump) - = return $ wrapRun dt assump nonPerfAssump +runDeal (SingleRunReq f dt assump nonPerfAssump) = return $ wrapRun f dt assump nonPerfAssump -- Stressing default assumption from AssetPerfAssumption @@ -292,6 +291,16 @@ queryDealTypeBool (UDeal _d) d s = Q.queryDealBool _d s d queryDealTypeBool (VDeal _d) d s = Q.queryDealBool _d s d queryDealTypeBool (PDeal _d) d s = Q.queryDealBool _d s d +testDealTypeBool :: DealType -> Date -> Pre -> Either String Bool +testDealTypeBool (MDeal _d) d p = Q.testPre d _d p +testDealTypeBool (RDeal _d) d p = Q.testPre d _d p +testDealTypeBool (IDeal _d) d p = Q.testPre d _d p +testDealTypeBool (LDeal _d) d p = Q.testPre d _d p +testDealTypeBool (FDeal _d) d p = Q.testPre d _d p +testDealTypeBool (UDeal _d) d p = Q.testPre d _d p +testDealTypeBool (VDeal _d) d p = Q.testPre d _d p +testDealTypeBool (PDeal _d) d p = Q.testPre d _d p + getDealBondMap :: DealType -> Map.Map BondName L.Bond getDealBondMap (MDeal d) = DB.bonds d getDealBondMap (RDeal d) = DB.bonds d @@ -313,25 +322,25 @@ getDealFeeMap (VDeal d) = DB.fees d getDealFeeMap (PDeal d) = DB.fees d doTweak :: Double -> RootFindTweak -> DealRunInput -> DealRunInput -doTweak r StressPoolDefault (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) +doTweak r StressPoolDefault (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) = let stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressDefaultAssetPerf (toRational r)) assumps stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressDefaultAssetPerf (toRational r)) mRevolving } in - (dt ,Just stressed, stressedNonPerf) + (dt ,Just stressed, stressedNonPerf, f) -doTweak r StressPoolPrepayment (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) +doTweak r StressPoolPrepayment (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) = let stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressPrepayAssetPerf (toRational r)) assumps stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressPrepayAssetPerf (toRational r)) mRevolving } in - (dt ,Just stressed, stressedNonPerf) + (dt ,Just stressed, stressedNonPerf, f) -doTweak r (MaxSpreadTo bn) (dt , mAssump, rAssump) - = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump) +doTweak r (MaxSpreadTo bn) (dt , mAssump, rAssump, f) + = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump, f) -doTweak r (SplitFixedBalance bn1 bn2) (dt , mAssump, rAssump) - = (modifyDealType (DM.SlideBalances bn1 bn2) r dt , mAssump, rAssump) +doTweak r (SplitFixedBalance bn1 bn2) (dt , mAssump, rAssump, f) + = (modifyDealType (DM.SlideBalances bn1 bn2) r dt , mAssump, rAssump, f) evalRootFindStop :: RootFindStop -> RunRespRight -> Double @@ -353,7 +362,6 @@ evalRootFindStop (BondIncurPrinLoss bn threshold) (dt,_,_,_) in (fromRational . toRational) $ threshold - (duePrinAmt-0.01) - evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_,pResult) = let -- bnds @@ -379,17 +387,18 @@ evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) Nothing -> -1 -- `debug` ("No IRR found for bond:"++ show bn) Just irr -> (fromRational . toRational) $ irr - target -- `debug` ("IRR for bond:"++ show target ++" is "++ show irr) + rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double -rootFindAlgo (dt ,poolAssumps, runAssumps) tweak stop r +rootFindAlgo (dt ,poolAssumps, runAssumps, f) tweak stop r = let - (dt' ,poolAssumps', runAssumps') = doTweak r tweak (dt ,poolAssumps, runAssumps) + (dt' ,poolAssumps', runAssumps', f) = doTweak r tweak (dt ,poolAssumps, runAssumps, f) in - case wrapRun dt' poolAssumps' runAssumps' of + case wrapRun f dt' poolAssumps' runAssumps' of Right runRespRight -> evalRootFindStop stop runRespRight -- `debug` ("Begin pool"++ show poolAssumps') Left errorMsg -> -1 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) -runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) tweak stop) +runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving},f) tweak stop) = return $ let itertimes = 500 @@ -404,30 +413,31 @@ runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssu SearchFailed -> Left "Not able to find the root" runDealScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) -runDealScenarios (MultiScenarioRunReq dt mAssumps nonPerfAssump) - = return $ Map.map (\singleAssump -> wrapRun dt (Just singleAssump) nonPerfAssump) mAssumps +runDealScenarios (MultiScenarioRunReq f dt mAssumps nonPerfAssump) + = return $ Map.map (\singleAssump -> wrapRun f dt (Just singleAssump) nonPerfAssump) mAssumps runMultiDeals :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) -runMultiDeals (MultiDealRunReq mDts assump nonPerfAssump) - = return $ Map.map (\singleDealType -> wrapRun singleDealType assump nonPerfAssump) mDts +runMultiDeals (MultiDealRunReq f mDts assump nonPerfAssump) + = return $ Map.map (\singleDealType -> wrapRun f singleDealType assump nonPerfAssump) mDts runDate :: RunDateReq -> Handler [Date] -runDate (RunDateReq sd dp md) = return $ - case md of - Nothing -> DU.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101") - Just d -> DU.genSerialDatesTill2 IE sd dp d +runDate (RunDateReq sd dp md) + = return $ + case md of + Nothing -> DU.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101") + Just d -> DU.genSerialDatesTill2 IE sd dp d runDealByRunScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) -runDealByRunScenarios (MultiRunAssumpReq dt mAssump nonPerfAssumpMap) - = return $ Map.map (wrapRun dt mAssump) nonPerfAssumpMap +runDealByRunScenarios (MultiRunAssumpReq f dt mAssump nonPerfAssumpMap) + = return $ Map.map (wrapRun f dt mAssump) nonPerfAssumpMap runDealByCombo :: RunDealReq -> Handler (Map.Map String RunResp) -runDealByCombo (MultiComboReq dMap assumpMap nonPerfAssumpMap) +runDealByCombo (MultiComboReq f dMap assumpMap nonPerfAssumpMap) = let dList = Map.toList dMap aList = Map.toList assumpMap nList = Map.toList nonPerfAssumpMap - r = [ (intercalate "^" [dk,ak,nk], wrapRun d a n) | (dk,d) <- dList, (ak,a) <- aList, (nk,n) <- nList ] + r = [ (intercalate "^" [dk,ak,nk], wrapRun f d a n) | (dk,d) <- dList, (ak,a) <- aList, (nk,n) <- nList ] rMap = Map.fromList r in return rMap @@ -468,4 +478,4 @@ main = Left exp -> Config 8081 Right c -> c print ("Engine start with version:"++ _version version1++";running at Port:"++ show _p) - run _p app \ No newline at end of file + run _p app diff --git a/app/MainBase.hs b/app/MainBase.hs index b85c8f06..83ee2ca0 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -121,7 +121,7 @@ data PoolTypeWrap = LPool (DB.PoolType AB.Loan) deriving(Show, Generic) -type RunPoolTypeRtn_ = Map.Map PoolId (CF.CashFlowFrame, Map.Map CutoffFields Balance) +type RunPoolTypeRtn_ = Map.Map PoolId CF.PoolCashflow type RunPoolTypeRtn = Either String RunPoolTypeRtn_ @@ -129,15 +129,15 @@ type RunPoolTypeRtn = Either String RunPoolTypeRtn_ data RunAssetReq = RunAssetReq Date [AB.AssetUnion] (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) (Maybe PricingMethod) deriving(Show, Generic) -type RunAssetResp = Either String ((CF.CashFlowFrame, Map.Map CutoffFields Balance), Maybe [PriceResult]) +type RunAssetResp = Either String (CF.AssetCashflow, Maybe [PriceResult]) type ScenarioName = String -type DealRunInput = (DealType, Maybe AP.ApplyAssumptionType, AP.NonPerfAssumption) -data RunDealReq = SingleRunReq DealType (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption - | MultiScenarioRunReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption --- multi pool perf - | MultiDealRunReq (Map.Map ScenarioName DealType) (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption -- multi deal struct - | MultiRunAssumpReq DealType (Maybe AP.ApplyAssumptionType) (Map.Map ScenarioName AP.NonPerfAssumption) -- multi run assump - | MultiComboReq (Map.Map ScenarioName DealType) (Map.Map ScenarioName (Maybe AP.ApplyAssumptionType)) (Map.Map ScenarioName AP.NonPerfAssumption) +type DealRunInput = (DealType, Maybe AP.ApplyAssumptionType, AP.NonPerfAssumption, [D.ExpectReturn]) +data RunDealReq = SingleRunReq [D.ExpectReturn] DealType (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption + | MultiScenarioRunReq [D.ExpectReturn] DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption --- multi pool perf + | MultiDealRunReq [D.ExpectReturn] (Map.Map ScenarioName DealType) (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption -- multi deal struct + | MultiRunAssumpReq [D.ExpectReturn] DealType (Maybe AP.ApplyAssumptionType) (Map.Map ScenarioName AP.NonPerfAssumption) -- multi run assump + | MultiComboReq [D.ExpectReturn] (Map.Map ScenarioName DealType) (Map.Map ScenarioName (Maybe AP.ApplyAssumptionType)) (Map.Map ScenarioName AP.NonPerfAssumption) deriving(Show, Generic) data RunSimDealReq = OASReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption @@ -147,8 +147,8 @@ data RunSimDealReq = OASReq DealType (Map.Map ScenarioName AP.ApplyAssumptionTyp type RunRespRight = (DealType , Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent],Map.Map String PriceResult) type RunResp = Either String RunRespRight -data RunPoolReq = SingleRunPoolReq PoolTypeWrap (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) - | MultiScenarioRunPoolReq PoolTypeWrap (Map.Map ScenarioName AP.ApplyAssumptionType) (Maybe [RateAssumption]) +data RunPoolReq = SingleRunPoolReq Bool PoolTypeWrap (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) + | MultiScenarioRunPoolReq Bool PoolTypeWrap (Map.Map ScenarioName AP.ApplyAssumptionType) (Maybe [RateAssumption]) deriving(Show, Generic) @@ -156,7 +156,7 @@ data RunDateReq = RunDateReq Date DatePattern (Maybe Date) deriving(Show, Generic) instance ToSchema RunDateReq -type PoolRunResp = Either String (Map.Map PoolId (CF.CashFlowFrame, Map.Map CutoffFields Balance)) +type PoolRunResp = Either String (Map.Map PoolId CF.PoolCashflow) type TargetBonds = [BondName] @@ -189,6 +189,7 @@ data RootFindResp = RFResult Double DealRunInput $(deriveJSON defaultOptions ''RootFindTweak) $(deriveJSON defaultOptions ''RootFindStop) +instance ToSchema D.ExpectReturn instance ToSchema RootFindReq instance ToSchema RootFindTweak instance ToSchema RootFindStop @@ -362,4 +363,4 @@ instance ToSchema RunDealReq instance ToSchema PoolTypeWrap instance ToSchema RunPoolReq instance ToSchema RunAssetReq -instance ToSchema RootFindResp \ No newline at end of file +instance ToSchema RootFindResp diff --git a/src/Asset.hs b/src/Asset.hs index 6686bd20..16018077 100644 --- a/src/Asset.hs +++ b/src/Asset.hs @@ -8,9 +8,9 @@ module Asset ( Asset(..), buildAssumptionPpyDefRecRate,buildAssumptionPpyDelinqDefRecRate - ,calcRecoveriesFromDefault + ,calcRecoveriesFromDefault,getCurBalance ,priceAsset,applyHaircut,buildPrepayRates,buildDefaultRates,getObligorFields - ,getObligorTags,getObligorId,getRecoveryLagAndRate,getDefaultDelinqAssump + ,getObligorTags,getObligorId,getRecoveryLagAndRate,getDefaultDelinqAssump,getOriginInfo ) where import qualified Data.Time as T diff --git a/src/AssetClass/AssetBase.hs b/src/AssetClass/AssetBase.hs index 81fe6b27..c8afcb3d 100644 --- a/src/AssetClass/AssetBase.hs +++ b/src/AssetClass/AssetBase.hs @@ -54,16 +54,6 @@ data AmortPlan = Level -- ^ for mortgage / french system -> -- | calculate period payment (Annuity/Level mortgage) calcPmt :: Balance -> IRate -> Int -> Amount --- calcPmt bal 0.0 periods = divideBI bal periods --- calcPmt bal periodRate periods = --- let --- periodRate1 = toRational periodRate --- r1 = ((1+periodRate1)^^periods) / ((1+periodRate1)^^periods-1) -- `debug` ("PR>>"++show periodRate) --- pmtFactor = periodRate1 * r1 -- `debug` ("R1>>"++ show r1) --- in --- mulBR bal pmtFactor -- `debug` ("Factor"++ show pmtFactor) - --- Generate by gork calcPmt bal rate periods | rate == 0.0 = divideBI bal periods | otherwise = let rate' = realToFrac rate :: Double diff --git a/src/Assumptions.hs b/src/Assumptions.hs index fefb6c53..3fc7d240 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -83,8 +83,8 @@ data ObligorStrategy = ObligorById [String] AssetPerf 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 + | ByObligor [ObligorStrategy] -- ^ assumption for a set of obligors | ByDealName (Map.Map DealName (ApplyAssumptionType, NonPerfAssumption)) -- ^ assumption for a named deal deriving (Show, Generic) diff --git a/src/Cashflow.hs b/src/Cashflow.hs index 9a4ce03f..9a0154e4 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -5,7 +5,7 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,combine,mergePoolCf,sumTsCF,tsSetLoss,tsSetRecovery - ,sizeCashFlowFrame,aggTsByDates + ,sizeCashFlowFrame,aggTsByDates,emptyCashFlowFrame ,mflowInterest,mflowPrincipal,mflowRecovery,mflowPrepayment ,mflowRental,mflowRate,sumPoolFlow,splitTrs,aggregateTsByDate ,mflowDefault,mflowLoss @@ -25,7 +25,10 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,mergeCf,buildStartTsRow ,txnCumulativeStats,consolidateCashFlow, cfBeginStatus, getBegBalCashFlowFrame ,splitCashFlowFrameByDate, mergePoolCf2, buildBegBal, extendCashFlow, patchBalance - ,getAllDatesCashFlowFrame,splitCf + ,splitPoolCashflowByDate + ,getAllDatesCashFlowFrame,splitCf, cutoffCashflow + ,AssetCashflow,PoolCashflow + ,emptyCashflow ) where import Data.Time (Day) @@ -34,7 +37,6 @@ import Lib (weightedBy,toDate,getIntervalFactors,daysBetween,paySeqLiabilitiesAm import Util (mulBR,mulBInt,mulIR,lastOf) import DateUtil ( splitByDate ) import Types ---import Deal.DealType import qualified Data.Map as Map import qualified Data.Time as T import qualified Data.List as L @@ -70,6 +72,9 @@ type Recoveries = [Recovery] type Rates = [Rate] type CumulativeStat = (CumPrincipal,CumPrepay,CumDelinq,CumDefault,CumRecovery,CumLoss) +type AssetCashflow = CashFlowFrame +type PoolCashflow = (AssetCashflow, Maybe [AssetCashflow]) +emptyCashflow = CashFlowFrame (0,epocDate,Nothing) [] opStats :: (Balance -> Balance -> Balance) -> Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat opStats op (Just (a1,b1,c1,d1,e1,f1)) (Just (a2,b2,c3,d2,e2,f2)) = Just (op a1 a2,op b1 b2,op c1 c3,op d1 d2,op e1 e2,op f1 f2) @@ -182,7 +187,6 @@ type BeginStatus = (BeginBalance, BeginDate, AccuredInterest) data CashFlowFrame = CashFlowFrame BeginStatus [TsRow] | MultiCashFlowFrame (Map.Map String [CashFlowFrame]) --- | CashFlowFrameIndex BeginStatus [TsRow] IR.Index deriving (Eq,Generic,Ord) cfBeginStatus :: Lens' CashFlowFrame BeginStatus @@ -228,6 +232,10 @@ instance NFData CashFlowFrame where sizeCashFlowFrame :: CashFlowFrame -> Int sizeCashFlowFrame (CashFlowFrame _ ts) = length ts +emptyCashFlowFrame :: CashFlowFrame -> Bool +emptyCashFlowFrame (CashFlowFrame _ []) = True +emptyCashFlowFrame (CashFlowFrame _ _) = False + getDatesCashFlowFrame :: CashFlowFrame -> [Date] getDatesCashFlowFrame (CashFlowFrame _ ts) = getDates ts @@ -257,6 +265,19 @@ splitCashFlowFrameByDate (CashFlowFrame status txns) d st in (CashFlowFrame status ls,CashFlowFrame newStatus rs) +splitPoolCashflowByDate :: PoolCashflow -> Date -> SplitType -> (PoolCashflow,PoolCashflow) +splitPoolCashflowByDate (poolCF, mAssetCfs) d st + = let + (lPoolCF,rPoolCF) = splitCashFlowFrameByDate poolCF d st + mAssetSplited = (\xs -> [ splitCashFlowFrameByDate x d st | x <- xs ]) <$> mAssetCfs + assetCfs = (\xs -> [ (lCf, rCf) | (lCf,rCf) <- xs ]) <$> mAssetSplited + lAssetCfs = (\xs -> fst <$> xs ) <$> assetCfs + rAssetCfs = (\xs -> snd <$> xs ) <$> assetCfs + in + ((lPoolCF, lAssetCfs) , (rPoolCF, rAssetCfs)) + + + getTxnLatestAsOf :: CashFlowFrame -> Date -> Maybe TsRow getTxnLatestAsOf (CashFlowFrame _ txn) d = L.find (\x -> getDate x <= d) $ reverse txn @@ -1074,6 +1095,19 @@ cutoffTrs d trs in (patchCumulative (0.0,0.0,0.0,0.0,0.0,0.0) [] afterTrs, m) +-- TODO need to fix accrue interest & cutoff stat +cutoffCashflow :: Date -> Dates -> CashFlowFrame -> CashFlowFrame +cutoffCashflow sd ds (CashFlowFrame st []) = CashFlowFrame st [] +cutoffCashflow sd ds (CashFlowFrame st txns) + = let + futureTxns = cutBy Inc Future sd txns + withBegTs [] = [] + withBegTs (tr:trs) = buildBegTsRow sd tr: tr :trs + aggTxns = aggTsByDates (withBegTs futureTxns) ds + in + CashFlowFrame (buildBegBal aggTxns, sd, Nothing) aggTxns + + extendTxns :: TsRow -> [Date] -> [TsRow] extendTxns tr ds = [ emptyTsRow d tr | d <- ds ] @@ -1104,6 +1138,7 @@ dropTailEmptyTxns :: [TsRow] -> [TsRow] dropTailEmptyTxns trs = reverse $ dropWhile isEmptyRow (reverse trs) + cashflowTxn :: Lens' CashFlowFrame [TsRow] cashflowTxn = lens getter setter where @@ -1130,8 +1165,5 @@ txnCumulativeStats = lens getter setter = ReceivableFlow d bal p i ppy def recovery loss mStat setter x _ = x - - - $(deriveJSON defaultOptions ''TsRow) $(deriveJSON defaultOptions ''CashFlowFrame) diff --git a/src/Deal.hs b/src/Deal.hs index c6b592ae..79adb9a9 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -392,41 +392,48 @@ changeDealStatus (d,why) newSt t@TestDeal{status=oldSt} = (Just (DealStatusChang -run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.CashFlowFrame -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre]) +run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.PoolCashflow -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre]) -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType))-> DL.DList ResultComponent -> Either String (TestDeal a,DL.DList ResultComponent) -run t@TestDeal{status=Ended} pCfM ads _ _ _ log = Right (prepareDeal t,(DL.snoc log (EndRun Nothing "By Status:Ended"))) -run t pCfM (Just []) _ _ _ log = Right (prepareDeal t,(DL.snoc log (EndRun Nothing "No Actions"))) -run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = Right (prepareDeal t, (DL.snoc log (EndRun (Just d) "Stop: Stated Maturity"))) -run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = Right (prepareDeal t, (DL.snoc log (EndRun (Just d) "Stop Run Flag"))) +run t@TestDeal{status=Ended} pCfM ads _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "By Status:Ended"))) +run t pCfM (Just []) _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "No Actions"))) +run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop: Stated Maturity"))) +run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop Run Flag"))) run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=dStatus ,waterfall=waterfallM,name=dealName,pool=pt,stats=_stat} poolFlowMap (Just (ad:ads)) rates calls rAssump log | all (== 0) futureCashToCollect && (queryCompound t (getDate ad) AllAccBalance == Right 0) && (dStatus /= Revolving) && (dStatus /= Warehousing Nothing) --TODO need to use prsim here to cover all warehouse status = do - let runContext = RunContext poolFlowMap rAssump rates + let runContext = RunContext poolFlowMap rAssump rates `debug` ("ending at date " ++ show (getDate ad)) (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions - return (prepareDeal finalDeal, (DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving"))) -- `debug` ("End of pool collection with logs with length "++ show (length log)) + return (finalDeal, (DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving"))) -- `debug` ("End of pool collection with logs with length "++ show (length log)) | otherwise = case ad of PoolCollection d _ -> if any (> 0) remainCollectionNum then let - cutOffPoolFlowMap = Map.map (\pflow -> CF.splitCashFlowFrameByDate pflow d EqToLeft) poolFlowMap - collectedFlow = Map.map fst cutOffPoolFlowMap -- `debug` ("PoolCollection : "++ show d ++ " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap) + cutOffPoolFlowMap = Map.map (\(pflow,mAssetFlow) -> + (CF.splitCashFlowFrameByDate pflow d EqToLeft + ,(\xs -> [ CF.splitCashFlowFrameByDate x d EqToLeft | x <- xs ]) <$> mAssetFlow) + ) + poolFlowMap + collectedFlow = Map.map (\(p,mAstFlow) -> (fst p, (\xs -> [ fst x | x <- xs ]) <$> mAstFlow)) cutOffPoolFlowMap -- `debug` ("PoolCollection : "++ show d ++ " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap) -- outstandingFlow = Map.map (CF.insertBegTsRow d . snd) cutOffPoolFlowMap - outstandingFlow = Map.map snd cutOffPoolFlowMap + outstandingFlow = Map.map (\(p,mAstFlow) -> (snd p, (\xs -> [ snd x | x <- xs ]) <$> mAstFlow)) cutOffPoolFlowMap -- deposit cashflow to SPV from external pool cf in do accs <- depositPoolFlow (collects t) d collectedFlow accMap -- `debug` ("PoolCollection: deposit >>"++ show d++">>>"++ show collectedFlow++"\n") - let dAfterDeposit = (appendCollectedCF d t collectedFlow) {accounts=accs} -- `debug` ("Collected flow"++ show collectedFlow) + let dAfterDeposit = (appendCollectedCF d t collectedFlow) {accounts=accs} -- newScheduleFlowMap = Map.map (over CF.cashflowTxn (cutBy Exc Future d)) (fromMaybe Map.empty (getScheduledCashflow t Nothing)) - let dealAfterUpdateScheduleFlow = over dealScheduledCashflow - (Map.map (\mflow -> over CF.cashflowTxn (cutBy Exc Future d) <$> mflow)) - dAfterDeposit + let newPt = case (pool dAfterDeposit) of + MultiPool pm -> MultiPool $ + Map.map + (\p -> over (P.poolFutureScheduleCf . _1 . CF.cashflowTxn) (cutBy Exc Future d) p) + pm + ResecDeal dMap -> ResecDeal dMap let runContext = RunContext outstandingFlow rAssump rates -- `debug` ("PoolCollection: before rc >>"++ show d++">>>"++ show (pool dAfterDeposit)) - (dRunWithTrigger0, rc1, ads2, newLogs0) <- runTriggers (dealAfterUpdateScheduleFlow,runContext,ads) d EndCollection -- `debug` ("PoolCollection: after update schedule flow >>"++ show d++">>"++show (pool dealAfterUpdateScheduleFlow)) + (dRunWithTrigger0, rc1, ads2, newLogs0) <- runTriggers (dAfterDeposit {pool = newPt},runContext,ads) d EndCollection let eopActionsLog = DL.fromList [ 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) (dAfterAction,rc2,newLogs) <- foldM (performActionWrap d) (dRunWithTrigger0 ,rc1 ,log ) waterfallToExe -- `debug` ("Pt 03"++ show d++">> context flow"++show (pool dRunWithTrigger0))-- `debug` ("End collection action"++ show waterfallToExe) @@ -465,7 +472,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= [DealStatusChangeTo d dStatus Called "Call by triggers before waterfall distribution", RunningWaterfall d W.CleanUp] (dealAfterCleanUp, rc_, newLogWaterfall_ ) <- foldM (performActionWrap d) (dRunWithTrigger0, rc1,log) cleanUpActions endingLogs <- Rpt.patchFinancialReports dealAfterCleanUp d newLogWaterfall_ - return (prepareDeal dealAfterCleanUp, DL.concat [logsBeforeDist,DL.fromList (newStLogs++[EndRun (Just d) "Clean Up"]),endingLogs]) -- `debug` ("Called ! "++ show d) + return (dealAfterCleanUp, DL.concat [logsBeforeDist,DL.fromList (newStLogs++[EndRun (Just d) "Clean Up"]),endingLogs]) -- `debug` ("Called ! "++ show d) else do (dAfterWaterfall, rc2, newLogsWaterfall) <- foldM (performActionWrap d) (dRunWithTrigger0,rc1,log) waterfallToExe -- `debug` ("In RunWaterfall Date"++show d++">>> status "++show (status dRunWithTrigger0)++"before run waterfall collected >>"++ show (pool dRunWithTrigger0)) @@ -550,7 +557,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= 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 + 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 -> @@ -665,15 +672,17 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= MakeWhole d spd walTbl -> let - schedulePoolFlowMap = Map.map (fromMaybe (CF.CashFlowFrame (0,epocDate,Nothing) [])) $ view dealScheduledCashflow t + schedulePoolFlowMap = case pt of + MultiPool pMap -> Map.map (fst . P.futureScheduleCf) pMap + ResecDeal uDealMap -> Map.map (view uDealFutureScheduleCf) uDealMap in do factor <- liftA2 (/) (queryCompound t d (FutureCurrentPoolBegBalance Nothing)) (queryCompound t d (FutureCurrentSchedulePoolBegBalance Nothing)) - let reduceCfs = Map.map (over CF.cashflowTxn (\xs -> (CF.scaleTsRow factor) <$> xs)) schedulePoolFlowMap -- need to apply with factor and trucate with date - (runDealWithSchedule,_) <- run t reduceCfs (Just ads) rates calls rAssump $ log + let reduceCfs = Map.map (\f -> (over CF.cashflowTxn (\xs -> CF.scaleTsRow factor <$> xs) f, Nothing ) ) schedulePoolFlowMap -- need to apply with factor and trucate with date + (runDealWithSchedule,_) <- run t reduceCfs (Just ads) rates calls rAssump log let bondWal = Map.map (L.calcWalBond d) (bonds runDealWithSchedule) -- `debug` ("Bond schedule flow"++ show (bonds runDealWithSchedule)) let bondSprd = Map.map (\x -> (spd + (fromMaybe 0 (lookupTable walTbl Up (fromRational x >))))) @@ -693,7 +702,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= L.payYield d intToPay bnd1) (bonds t) bondPricingResult - run t {bonds = depositBondFlow, status = Ended } poolFlowMap (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call") + run t {bonds = depositBondFlow, status = Ended } Map.empty (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call") FundBond d Nothing bName accName fundAmt -> let @@ -803,14 +812,14 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= do (dealAfterCleanUp, rc_, newLogWaterfall_ ) <- foldM (performActionWrap d) (t, runContext, log) cleanUpActions endingLogs <- Rpt.patchFinancialReports dealAfterCleanUp d newLogWaterfall_ - return (prepareDeal dealAfterCleanUp, DL.snoc (endingLogs `DL.append` newStLogs) (EndRun (Just d) "Clean Up")) -- `debug` ("Called ! "++ show d) + return (dealAfterCleanUp, DL.snoc (endingLogs `DL.append` newStLogs) (EndRun (Just d) "Clean Up")) -- `debug` ("Called ! "++ show d) _ -> run t poolFlowMap (Just ads) rates calls rAssump log StopRunTest d pres -> do flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- pres ] case all id flags of - True -> Right (prepareDeal t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags)))) + True -> Right (t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags)))) _ -> run t poolFlowMap (Just ads) rates calls rAssump log @@ -818,25 +827,23 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= where cleanUpActions = Map.findWithDefault [] W.CleanUp (waterfall t) -- `debug` ("Running AD"++show(ad)) - remainCollectionNum = Map.elems $ Map.map CF.sizeCashFlowFrame poolFlowMap - futureCashToCollect = Map.elems $ Map.map (\pcf -> sum (CF.tsTotalCash <$> view CF.cashflowTxn pcf)) poolFlowMap + remainCollectionNum = Map.elems $ Map.map (\(x,_) -> CF.sizeCashFlowFrame x ) poolFlowMap + futureCashToCollect = Map.elems $ Map.map (\(pcf,_) -> sum (CF.tsTotalCash <$> view CF.cashflowTxn pcf)) poolFlowMap run t empty Nothing Nothing Nothing Nothing log = do - (t, ads, pcf, unStressPcf) <- getInits t Nothing Nothing + (t, ads, pcf, unStressPcf) <- getInits S.empty 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 []") +run t empty _ _ _ _ log = Right (t, log) -- `debug` ("End with pool CF is []") -- reserved for future used -data ExpectReturn = DealPoolFlow - | DealPoolFlowPricing -- ^ default option, return pricing and bond/pool/account/fee etc cashflow - | DealTxns - | ExecutionSummary - deriving (Show,Generic) +data ExpectReturn = DealLogs + | AssetLevelFlow + deriving (Show,Generic,Ord,Eq) -- priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [(Date,Balance)]) @@ -990,23 +997,36 @@ readCallOptions opts = in (concat (fst <$> result), concat (snd <$> result)) - -runDeal :: Ast.Asset a => TestDeal a -> ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption +consoleDeal :: Ast.Asset a => (S.Set ExpectReturn) -> TestDeal a -> TestDeal a +consoleDeal rs t = + let + m = S.minView rs + in + case m of + Nothing -> t + Just (x, _rs) -> + case x of + DealLogs -> t + AssetLevelFlow -> t + +runDeal :: Ast.Asset a => TestDeal a -> S.Set ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption -> Either String (TestDeal a, Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent], Map.Map String PriceResult) -runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts ,AP.pricing = mPricing ,AP.revolving = mRevolving ,AP.interest = mInterest} +runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts ,AP.pricing = mPricing ,AP.revolving = mRevolving ,AP.interest = mInterest} | not runFlag = Left $ intercalate ";" $ show <$> valLogs | otherwise = do - (newT, ads, pcf, unStressPcf) <- getInits t perfAssumps (Just nonPerfAssumps) - (finalDeal, logs) <- run (removePoolCf newT) - pcf - (Just ads) - mInterest - (readCallOptions <$> opts) - mRevolvingCtx - DL.empty - let poolFlowUsed = Map.map (fromMaybe (CF.CashFlowFrame (0,toDate "19000101",Nothing) [])) (getAllCollectedFrame finalDeal Nothing) - let poolFlowUsedNoEmpty = Map.map (over CF.cashflowTxn CF.dropTailEmptyTxns) poolFlowUsed + (newT, ads, pcf, unStressPcf) <- getInits er t perfAssumps (Just nonPerfAssumps) + (_finalDeal, logs) <- run (removePoolCf newT) + pcf + (Just ads) + mInterest + (readCallOptions <$> opts) + mRevolvingCtx + DL.empty + let finalDeal = prepareDeal er _finalDeal + let poolFlowUsedNoEmpty = Map.map + (over CF.cashflowTxn CF.dropTailEmptyTxns) + (getAllCollectedFrame finalDeal Nothing) bndPricing <- case mPricing of (Just p) -> priceBonds finalDeal p Nothing -> Right Map.empty @@ -1030,72 +1050,94 @@ getRunResult t = os_bn_i ++ os_bn_b -- `debug` ("Done with get result") 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} + +-- | consolidate pool cashflow +-- consolidate bond cashflow and patch factor +prepareDeal :: Ast.Asset a => S.Set ExpectReturn -> TestDeal a -> TestDeal a +prepareDeal er t@TestDeal {bonds = bndMap ,pool = poolType } = let - pIdCf = view dealCashflow t - newPtMap = Map.map (\mCf -> (over CF.cashflowTxn CF.dropTailEmptyTxns) <$> mCf ) - pIdCf - t1 = set dealCashflow newPtMap t + consolePoolFlowFn = over CF.cashflowTxn CF.dropTailEmptyTxns + rmAssetLevelFn xs + | S.member AssetLevelFlow er = xs + | otherwise = [] in - t1 {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap } + t {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap + ,pool = poolType & over (_MultiPool . mapped . P.poolFutureCf ._1) consolePoolFlowFn + & over (_ResecDeal . mapped . uDealFutureCf) consolePoolFlowFn + & over (_MultiPool . mapped . P.poolFutureCf . _2 . _Just) rmAssetLevelFn + } -appendCollectedCF :: Ast.Asset a => Date -> TestDeal a -> Map.Map PoolId CF.CashFlowFrame -> TestDeal a +appendCollectedCF :: Ast.Asset a => Date -> TestDeal a -> Map.Map PoolId CF.PoolCashflow -> TestDeal a -- ^ append cashflow frame (consolidate by a date) into deals collected pool appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap - = let + = let newPt = case pt of MultiPool poolM -> MultiPool $ Map.foldrWithKey - (\k (CF.CashFlowFrame _ txnCollected) acc -> + (\k (CF.CashFlowFrame _ txnCollected, mAssetFlow) acc -> let - currentStats = case view P.poolFutureTxn (acc Map.! k) of + currentStats = case view (P.poolFutureCf . _1 . CF.cashflowTxn) (acc Map.! k) of [] -> P.poolBegStats (acc Map.! k) txns -> fromMaybe (0,0,0,0,0,0) $ view CF.txnCumulativeStats (last txns) balInCollected = case length txnCollected of 0 -> 0 _ -> view CF.tsRowBalance $ last txnCollected txnToAppend = CF.patchCumulative currentStats [] txnCollected - accUpdated = Map.adjust (over P.poolFutureTxn (++ txnToAppend)) k acc + -- insert aggregated pool flow + accUpdated = acc & ix k %~ over (P.poolFutureCf . _1 . CF.cashflowTxn) (++ txnToAppend) + -- insert breakdown asset flow + accUpdated' = case mAssetFlow of + Nothing -> accUpdated + Just collectedAssetFlow -> + let + appendFn Nothing = Just collectedAssetFlow + appendFn (Just cfs) + | length cfs == length collectedAssetFlow = Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip cfs collectedAssetFlow ] + | length collectedAssetFlow > length cfs = + let + dummyCashFrames = replicate (length collectedAssetFlow - length cfs) CF.emptyCashflow + in + Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip (cfs++dummyCashFrames) collectedAssetFlow ] + | otherwise = error "incomping cashflow number shall greater than existing cashflow number" + in + accUpdated & ix k %~ (\p -> over (P.poolFutureCf . _2) appendFn p) in Map.adjust (over P.poolIssuanceStat (Map.insert RuntimeCurrentPoolBalance balInCollected)) - k accUpdated) - poolM + k accUpdated') + poolM poolInflowMap ResecDeal uds -> ResecDeal $ Map.foldrWithKey - (\k (CF.CashFlowFrame _ newTxns) acc-> + (\k (CF.CashFlowFrame _ newTxns, _) acc-> Map.adjust (over uDealFutureTxn (++ newTxns)) k acc) - uds poolInflowMap + uds + poolInflowMap in - t {pool = newPt} -- `debug` ("after insert bal"++ show newPt) + t {pool = newPt} -- `debug` ("after insert bal"++ show newPt) -- ^ emtpy deal's pool cashflow removePoolCf :: Ast.Asset a => TestDeal a -> TestDeal a removePoolCf t@TestDeal{pool=pt} = let newPt = case pt of - MultiPool pM -> MultiPool $ Map.map (set P.poolFutureCf Nothing) pM + MultiPool pm -> MultiPool $ set (mapped . P.poolFutureCf) (CF.CashFlowFrame (0,epocDate,Nothing) [], Nothing) pm ResecDeal uds -> ResecDeal uds - _ -> error "not implement" + _ -> error $ "not implement:" ++ show pt in t {pool = newPt} - - - -- | 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 [] (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 +runPool (P.Pool [] ((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") -- project contractual cashflow if nothing found in pool perf assumption @@ -1108,10 +1150,10 @@ runPool (P.Pool as _ _ asof _ _) Nothing mRates return [ (x, Map.empty) | x <- cf ] -- asset cashflow with credit stress ---- By pool level -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates +runPool (P.Pool as (CF.CashFlowFrame _ [],_) (CF.CashFlowFrame _ [],_) asof _ _) (Just (AP.PoolLevel assumps)) mRates = sequenceA $ parMap rdeepseq (\x -> Ast.projCashflow x asof assumps mRates) as ---- By index -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = +runPool (P.Pool as (CF.CashFlowFrame _ [],_) (CF.CashFlowFrame _ [],_) asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = let numAssets = length as in @@ -1120,7 +1162,7 @@ runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRat sequenceA $ parMap rdeepseq (\(x, a) -> Ast.projCashflow x asof a mRates) (zip as _assumps) ---- By Obligor -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = +runPool (P.Pool as (CF.CashFlowFrame _ [],_) (CF.CashFlowFrame _ [],_) asof _ _) (Just (AP.ByObligor obligorRules)) mRates = let -- result cf,rules,assets -- matchAssets:: Ast.Asset c => [Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> [AP.ObligorStrategy] @@ -1209,18 +1251,21 @@ runPool _a _b _c = Left $ "Failed to match" ++ show _a ++ show _b ++ show _c -- ^ patch issuance balance for PreClosing Deal patchIssuanceBalance :: Ast.Asset a => DealStatus -> Map.Map PoolId Balance -> PoolType a -> PoolType a -patchIssuanceBalance (Warehousing _) balM pt = patchIssuanceBalance (PreClosing Amortizing) balM pt +-- patchIssuanceBalance (Warehousing _) balM pt = patchIssuanceBalance (PreClosing Amortizing) balM pt patchIssuanceBalance (PreClosing _ ) balM pt = case pt of - MultiPool pM -> MultiPool $ Map.mapWithKey (\k v -> over P.poolIssuanceStat (Map.insert IssuanceBalance (Map.findWithDefault 0.0 k balM)) v) pM + MultiPool pM -> MultiPool $ Map.mapWithKey + (\k v -> over P.poolIssuanceStat (Map.insert IssuanceBalance (Map.findWithDefault 0.0 k balM)) v) + pM ResecDeal pM -> ResecDeal pM --TODO patch balance for resec deal patchIssuanceBalance _ bal p = p -- `debug` ("NO patching ?") -patchScheduleFlow :: Ast.Asset a => Map.Map PoolId CF.CashFlowFrame -> PoolType a -> PoolType a + +patchScheduleFlow :: Ast.Asset a => Map.Map PoolId CF.PoolCashflow -> PoolType a -> PoolType a patchScheduleFlow flowM pt = case pt of - MultiPool pM -> MultiPool $ Map.intersectionWith (set P.poolFutureScheduleCf) (Just <$> flowM) pM + MultiPool pM -> MultiPool $ Map.intersectionWith (set P.poolFutureScheduleCf) flowM pM ResecDeal pM -> ResecDeal pM patchRuntimeBal :: Ast.Asset a => Map.Map PoolId Balance -> PoolType a -> PoolType a @@ -1234,51 +1279,45 @@ patchRuntimeBal balMap (MultiPool pM) patchRuntimeBal balMap pt = pt -runPoolType :: Ast.Asset a => PoolType a -> Maybe AP.ApplyAssumptionType - -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId (CF.CashFlowFrame, Map.Map CutoffFields Balance)) - -runPoolType (MultiPool pm) (Just (AP.ByName assumpMap)) mNonPerfAssump - = sequenceA $ Map.mapWithKey - (\k p -> (P.aggPool (P.issuanceStat p)) <$> - (runPool p (AP.PoolLevel <$> Map.lookup k assumpMap) (AP.interest =<< mNonPerfAssump))) - pm -runPoolType (MultiPool pm) (Just (AP.ByPoolId assumpMap)) mNonPerfAssump - = sequenceA $ Map.mapWithKey - (\k p -> (P.aggPool (P.issuanceStat p)) <$> - (runPool p (Map.lookup k assumpMap) (AP.interest =<< mNonPerfAssump))) - pm +runPoolType :: Ast.Asset a => Bool -> PoolType a -> Maybe AP.ApplyAssumptionType + -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId CF.PoolCashflow) -runPoolType (MultiPool pm) mAssumps mNonPerfAssump +runPoolType flag (MultiPool pm) (Just poolAssumpType) mNonPerfAssump + = let + rateAssump = AP.interest =<< mNonPerfAssump + calcPoolCashflow (AP.ByName assumpMap) pid v = runPool v (AP.PoolLevel <$> Map.lookup pid assumpMap) rateAssump + calcPoolCashflow (AP.ByPoolId assumpMap) pid v = runPool v (Map.lookup pid assumpMap) rateAssump + calcPoolCashflow poolAssump pid v = runPool v (Just poolAssump) rateAssump + in + sequenceA $ + Map.mapWithKey + (\k v -> + let + poolBegStats = P.issuanceStat v + in + do + assetCfs <- calcPoolCashflow poolAssumpType k v + let (poolCf,_) = P.aggPool poolBegStats assetCfs + return (poolCf, if flag then + Just $ fst <$> assetCfs + else + Nothing)) + pm + +runPoolType flag (MultiPool pm) mAssumps mNonPerfAssump = sequenceA $ - Map.map (\p -> (P.aggPool (P.issuanceStat p)) <$> (runPool p mAssumps (AP.interest =<< mNonPerfAssump))) + Map.map (\p -> + do + assetFlows <- runPool p mAssumps (AP.interest =<< mNonPerfAssump) + let (poolCf, poolStatMap) = P.aggPool (P.issuanceStat p) assetFlows + return (poolCf, if flag then + Just $ fst <$> assetFlows + else + Nothing)) pm -runPoolType (ResecDeal dm) mAssumps mNonPerfAssump - -- = Map.foldrWithKey (\(DealBondFlow dn bn sd pct) (dname, cflow, stat) m -> - -- - -- Map.insert (DealBondFlow dname bn sd pct) (cflow, stat) m) - -- Map.empty $ - -- Map.mapWithKey (\(DealBondFlow dn bn sd pct) (uDeal, mAssump) -> - -- let - -- (poolAssump,dealAssump) = case mAssump of - -- Nothing -> (Nothing, AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing) - -- Just (_poolAssump, _dealAssump) -> (Just _poolAssump, _dealAssump) - -- in - -- do - -- (dealRunned, _, _, _) <- runDeal uDeal DealPoolFlowPricing poolAssump dealAssump - -- let bondFlow = cutBy Inc Future sd $ concat $ Map.elems $ Map.map Stmt.getTxns $ getBondStmtByName dealRunned (Just [bn]) -- `debug` ("Bondflow from underlying runned"++ show (getBondStmtByName dealRunned (Just [bn]))) - -- let bondFlowRated = (\(BondTxn d b i p r c di dioi f t) -> CF.BondFlow d b p i) <$> Stmt.scaleByFactor pct bondFlow -- `debug` ("Bondflow from underlying"++ show bondFlow) - -- return (name uDeal, CF.CashFlowFrame (0,sd,Nothing) bondFlowRated, Map.empty)) $ - -- Map.mapWithKey (\_ (UnderlyingDeal uDeal _ _ _) -> - -- let - -- dName = name uDeal -- `debug` ("Getting name of underlying deal:"++ (name uDeal)) - -- mAssump = case mAssumps of - -- Just (AP.ByDealName assumpMap) -> Map.lookup dName assumpMap - -- _ -> Nothing - -- in - -- (uDeal, mAssump)) - -- dm +runPoolType flag (ResecDeal dm) mAssumps mNonPerfAssump = let assumpMap = Map.mapWithKey (\_ (UnderlyingDeal uDeal _ _ _) -> @@ -1297,18 +1336,18 @@ runPoolType (ResecDeal dm) mAssumps mNonPerfAssump Just (_poolAssump, _dealAssump) -> (Just _poolAssump, _dealAssump) in do - (dealRunned, _, _, _) <- runDeal uDeal DealPoolFlowPricing poolAssump dealAssump - let bondFlow = cutBy Inc Future sd $ concat $ Map.elems $ Map.map (DL.toList . Stmt.getTxns) $ getBondStmtByName dealRunned (Just [bn]) -- `debug` ("Bondflow from underlying runned"++ show (getBondStmtByName dealRunned (Just [bn]))) - let bondFlowRated = (\(BondTxn d b i p r c di dioi f t) -> CF.BondFlow d b p i) <$> Stmt.scaleByFactor pct bondFlow -- `debug` ("Bondflow from underlying"++ show bondFlow) - return (CF.CashFlowFrame (0,sd,Nothing) bondFlowRated, Map.empty)) + (dealRunned, _, _, _) <- runDeal uDeal (S.fromList []) poolAssump dealAssump + let bondFlow = cutBy Inc Future sd $ concat $ Map.elems $ Map.map (DL.toList . Stmt.getTxns) $ getBondStmtByName dealRunned (Just [bn]) + let bondFlowRated = (\(BondTxn d b i p r c di dioi f t) -> CF.BondFlow d b p i) <$> Stmt.scaleByFactor pct bondFlow + return (CF.CashFlowFrame (0,sd,Nothing) bondFlowRated, Nothing)) assumpMap in sequenceA ranMap -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,stats=_stats} mAssumps mNonPerfAssump = +getInits :: Ast.Asset a => S.Set ExpectReturn -> TestDeal a -> Maybe AP.ApplyAssumptionType -> Maybe AP.NonPerfAssumption + -> Either String (TestDeal a,[ActionOnDate], Map.Map PoolId CF.PoolCashflow, Map.Map PoolId CF.PoolCashflow) +getInits er t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_stats} mAssumps mNonPerfAssump = let expandInspect sd ed (AP.InspectPt dp ds) = [ InspectDS _d [ds] | _d <- genSerialDatesTill2 II sd dp ed ] expandInspect sd ed (AP.InspectRpt dp dss) = [ InspectDS _d dss | _d <- genSerialDatesTill2 II sd dp ed ] @@ -1450,35 +1489,60 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s 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) - let poolCfTsMwithBegRow = Map.map (\case - (x:xs) -> buildBegTsRow startDate x:x:xs - [] -> []) - poolCfTsM - let poolAggCfM = Map.map (\x -> CF.aggTsByDates x (getDates pActionDates)) poolCfTsMwithBegRow - let pCollectionCfAfterCutoff = Map.map (\case - [] -> CF.CashFlowFrame (0,startDate,Nothing) [] - (txn:txns) -> CF.CashFlowFrame (CF.mflowBegBalance txn,startDate,Nothing) (txn:txns) ) - poolAggCfM -- `debug` ("Pool agg cfm"++ show (Map.map (sliceBy II (toDate "20241201") (toDate "20241231") ) poolAggCfM)) - let pTxnOfSpv = Map.map (\(CF.CashFlowFrame _ txns, pstats) -> cutBy Inc Future startDate txns) pScheduleCfM - let pAggCfM = Map.map (\case - [] -> [] - (x:xs) -> buildBegTsRow startDate x:x:xs) pTxnOfSpv - let pUnstressedAfterCutoff = Map.map (CF.CashFlowFrame (0,startDate,Nothing)) pAggCfM + pCfM <- runPoolType True thePool mAssumps mNonPerfAssump + pScheduleCfM <- runPoolType True thePool Nothing mNonPerfAssump + -- Cutoff cashflow by start date + -- let poolCfTsM = Map.map (\((poolCf, pstats), mAssetFlow) + -- -> (over CF.cashflowTxn (cutBy Inc Future startDate) poolCf + -- ,(map (over CF.cashflowTxn (cutBy Inc Future startDate))) <$> mAssetFlow) + -- ) + -- pCfM + -- let poolCfTsMwithBegRow = Map.map (\case + -- (x:xs) -> buildBegTsRow startDate x:x:xs + -- [] -> []) + -- poolCfTsM + -- let poolAggCfM = Map.map (\x -> CF.aggTsByDates x (getDates pActionDates)) poolCfTsMwithBegRow + -- let pCollectionCfAfterCutoff = Map.map (\case + -- [] -> CF.CashFlowFrame (0,startDate,Nothing) [] + -- (txn:txns) -> CF.CashFlowFrame (CF.mflowBegBalance txn,startDate,Nothing) (txn:txns) ) + -- poolAggCfM -- `debug` ("Pool agg cfm"++ show (Map.map (sliceBy II (toDate "20241201") (toDate "20241231") ) poolAggCfM)) + let aggDates = getDates pActionDates + let pCollectionCfAfterCutoff = Map.map + (\(pCf, mAssetFlow) -> + let + pCf' = CF.cutoffCashflow startDate aggDates pCf + in + (pCf' ,(\xs -> [ CF.cutoffCashflow startDate aggDates x | x <- xs ] ) <$> mAssetFlow) + ) + pCfM + + -- let pTxnOfSpv = Map.map (\((CF.CashFlowFrame _ txns, pstats), mAssetFlow) -> cutBy Inc Future startDate txns) pScheduleCfM + -- let pAggCfM = Map.map + -- (\case + -- [] -> [] + -- (x:xs) -> buildBegTsRow startDate x:x:xs) + -- pTxnOfSpv + -- let pUnstressedAfterCutoff = Map.map (CF.CashFlowFrame (0,startDate,Nothing)) pAggCfM + let pUnstressedAfterCutoff = Map.map + (\(pCf, mAssetFlow) -> + let + pCf' = CF.cutoffCashflow startDate aggDates pCf + in + (pCf' + ,(\xs -> [ CF.cutoffCashflow startDate aggDates x | x <- xs ]) <$> mAssetFlow) + ) + pScheduleCfM + let poolWithSchedule = patchScheduleFlow pUnstressedAfterCutoff thePool -- `debug` ("D") - let poolWithIssuanceBalance = patchIssuanceBalance status (Map.map - (\case - [] -> 0 - txns -> (CF.mflowBegBalance . head) txns) - poolAggCfM) - poolWithSchedule - let poolWithRunPoolBalance = patchRuntimeBal (Map.map (\(CF.CashFlowFrame (b,_,_) _) -> b) pCollectionCfAfterCutoff) poolWithIssuanceBalance + let poolWithIssuanceBalance = patchIssuanceBalance + status + ((\(_pflow,_) -> CF.getBegBalCashFlowFrame _pflow) <$> pCollectionCfAfterCutoff) + poolWithSchedule + let poolWithRunPoolBalance = patchRuntimeBal + (Map.map (\(CF.CashFlowFrame (b,_,_) _,_) -> b) pCollectionCfAfterCutoff) + poolWithIssuanceBalance let newStat = if (isPreClosing t) then _stats & (over _4) (`Map.union` (Map.fromList [(BondPaidPeriod,0),(PoolCollectedPeriod,0)])) @@ -1490,7 +1554,6 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s , pUnstressedAfterCutoff) -- ^ UI translation : to read pool cash --- TODO: need to make this a Maybe readProceeds :: PoolSource -> CF.TsRow -> Either String Balance readProceeds CollectedInterest x = Right $ CF.mflowInterest x readProceeds CollectedPrincipal x = Right $ CF.mflowPrincipal x @@ -1503,17 +1566,18 @@ readProceeds CollectedFeePaid x = Right $ CF.mflowFeePaid x readProceeds a _ = Left $ " Failed to find pool cashflow field from pool cashflow rule "++show a -extractTxnsFromFlowFrameMap :: Maybe [PoolId] -> Map.Map PoolId CF.CashFlowFrame -> [CF.TsRow] +extractTxnsFromFlowFrameMap :: Maybe [PoolId] -> Map.Map PoolId CF.PoolCashflow -> [CF.TsRow] extractTxnsFromFlowFrameMap mPids pflowMap = - case mPids of - Nothing -> extractTxns pflowMap - Just pids -> extractTxns $ Map.filterWithKey (\k _ -> k `elem` pids) pflowMap - where - extractTxns m = concat $ (view CF.cashflowTxn) <$> Map.elems m - -- extractTxns m = concatMap $ (view CF.cashflowTxn) $ Map.elems m + let + extractTxns :: Map.Map PoolId CF.PoolCashflow -> [CF.TsRow] + extractTxns m = concat $ (view (_1 . CF.cashflowTxn)) <$> Map.elems m + in + case mPids of + Nothing -> extractTxns pflowMap + Just pids -> extractTxns $ Map.filterWithKey (\k _ -> k `elem` pids) pflowMap -- ^ deposit cash to account by collection rule -depositInflow :: Date -> W.CollectionRule -> Map.Map PoolId CF.CashFlowFrame -> Map.Map AccountName A.Account -> Either String (Map.Map AccountName A.Account) +depositInflow :: Date -> W.CollectionRule -> Map.Map PoolId CF.PoolCashflow -> Map.Map AccountName A.Account -> Either String (Map.Map AccountName A.Account) depositInflow d (W.Collect mPids s an) pFlowMap amap = do amts <- sequenceA $ readProceeds s <$> txns @@ -1540,7 +1604,7 @@ depositInflow d (W.CollectByPct mPids s splitRules) pFlowMap amap --TODO need depositInflow _ a _ _ = Left $ " Failed to match collection rule "++ show a -- ^ deposit cash to account by pool map CF and rules -depositPoolFlow :: [W.CollectionRule] -> Date -> Map.Map PoolId CF.CashFlowFrame -> Map.Map String A.Account -> Either String (Map.Map String A.Account) +depositPoolFlow :: [W.CollectionRule] -> Date -> Map.Map PoolId CF.PoolCashflow -> Map.Map String A.Account -> Either String (Map.Map String A.Account) depositPoolFlow rules d pFlowMap amap -- = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules = foldM (\acc rule -> depositInflow d rule pFlowMap acc) amap rules diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 06f0104d..f2d9406b 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -375,7 +375,7 @@ buyRevolvingPool d r rp@(AssetCurve aus) data RunContext a = RunContext{ - runPoolFlow:: Map.Map PoolId CF.CashFlowFrame + runPoolFlow:: Map.Map PoolId CF.PoolCashflow ,revolvingAssump:: Maybe (Map.Map String (RevolvingPool ,AP.ApplyAssumptionType)) ,revolvingInterestRateAssump:: Maybe [RateAssumption] } @@ -568,13 +568,11 @@ performActionWrap d ResecDeal _ -> error "Not implement on buy resec deal" let newAccMap = Map.adjust (A.draw purchaseAmt d (PurchaseAsset revolvingPoolName boughtAssetBal)) accName accsMap -- `debug` ("Asset bought total bal"++ show boughtAssetBal) - cfFrameBought <- projAssetUnionList [updateOriginDate2 d ast | ast <- assetBought ] d perfAssumps mRates -- `debug` ("Date: " ++ show d ++ "Asset bought"++ show [updateOriginDate2 d ast | ast <- assetBought ]) - let cfBought = fst cfFrameBought -- `debug` ("In Buy>>>"++ show d ++"Cf bought"++ show (fst cfFrameBought)) - let newPcf = Map.adjust (\cfOrigin@(CF.CashFlowFrame st trs) -> + (cfBought ,_)<- projAssetUnionList [updateOriginDate2 d ast | ast <- assetBought ] d perfAssumps mRates -- `debug` ("Date: " ++ show d ++ "Asset bought"++ show [updateOriginDate2 d ast | ast <- assetBought ]) + let newPcf = Map.adjust (\(cfOrigin@(CF.CashFlowFrame st trs), mAflow) -> let - dsInterval = getDate <$> trs -- `debug` ("Date"++ show d ++ "origin cf \n"++ show cfOrigin) - boughtCfDates = getDate <$> view CF.cashflowTxn cfBought -- `debug` ("In Buy>>>"++"Date"++ show d++ "Cf bought 0\n"++ show cfBought) - + dsInterval = getDate <$> trs + boughtCfDates = getDate <$> view CF.cashflowTxn cfBought newAggDates = case (dsInterval,boughtCfDates) of ([],[]) -> [] (_,[]) -> [] -- `debug` ("hit with non cash date from bought"++ show dsInterval) @@ -589,11 +587,12 @@ performActionWrap d else sliceDates (SliceAfter lastOdate) bDs - mergedCf = CF.mergePoolCf2 cfOrigin cfBought -- `debug` ("Buy Date : "++show d ++ "CF bought \n"++ show (over CF.cashflowTxn (slice 0 30) cfBought) ) + mergedCf = CF.mergePoolCf2 cfOrigin cfBought in - over CF.cashflowTxn (`CF.aggTsByDates` (dsInterval ++ newAggDates)) mergedCf )-- `debug` ("In Buy>>>"++"Date "++show d++" Merged CF\n"++ show mergedCf)) + ((over CF.cashflowTxn (`CF.aggTsByDates` (dsInterval ++ newAggDates)) mergedCf), (++ [cfBought]) <$> mAflow) + ) pIdToChange - pFlowMap -- `debug` ("pid To change"++ show pIdToChange++ "P flow map"++ show pFlowMap) + pFlowMap let newRc = rc {runPoolFlow = newPcf -- `debug` ("In Buy>>>"++show d ++ "New run pool >> \n"++ show newPcf) ,revolvingAssump = Just (Map.insert revolvingPoolName (poolAfterBought, perfAssumps) rMap)} @@ -624,8 +623,8 @@ performActionWrap d (W.LiquidatePool lm an mPid) = let liqFunction = \(p@P.Pool{ P.issuanceStat = m} ) - -> over (P.poolFutureScheduleCf . _Just) (CF.extendCashFlow d) $ - over (P.poolFutureCf . _Just) (CF.extendCashFlow d) $ + -> over (P.poolFutureScheduleCf . _1) (CF.extendCashFlow d) $ + over (P.poolFutureCf . _1 ) (CF.extendCashFlow d) $ p { P.issuanceStat = Just (Map.insert RuntimeCurrentPoolBalance 0 (fromMaybe Map.empty m)) } poolMapToLiq = case (pt, mPid) of @@ -655,7 +654,7 @@ performActionWrap d liqComment = LiquidationProceeds (fromMaybe [] mPid) accMapAfterLiq = Map.adjust (A.deposit liqAmt d liqComment) an accMap -- REMOVE future cf - newPfInRc = foldr (Map.adjust (set CF.cashflowTxn [])) pcf (Map.keys poolMapToLiq) + newPfInRc = foldr (Map.adjust (set (_1 . CF.cashflowTxn) [])) pcf (Map.keys poolMapToLiq) -- Update current balance to zero in Right (t {accounts = accMapAfterLiq , pool = newPt} , rc {runPoolFlow = newPfInRc}, logs) diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index 7080db1c..19a6479a 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -8,13 +8,14 @@ module Deal.DealBase (TestDeal(..),SPV(..),dealBonds,dealFees,dealAccounts,dealPool,PoolType(..),getIssuanceStats ,getAllAsset,getAllAssetList,getAllCollectedFrame,getLatestCollectFrame,getAllCollectedTxns - ,getIssuanceStatsConsol,getAllCollectedTxnsList,dealScheduledCashflow - ,getPoolIds,getBondByName, UnderlyingDeal(..),dealCashflow, uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..) + ,getIssuanceStatsConsol,getAllCollectedTxnsList + ,getPoolIds,getBondByName, UnderlyingDeal(..), uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..) ,sortActionOnDate,dealBondGroups ,viewDealBondsByNames,poolTypePool,viewBondsInMap,bondGroupsBonds ,increaseBondPaidPeriod,increasePoolCollectedPeriod ,DealStatFields(..),getDealStatInt,isPreClosing,populateDealDates ,bondTraversal,findBondByNames,updateBondInMap + ,_MultiPool,_ResecDeal,uDealFutureCf,uDealFutureScheduleCf ) where import qualified Accounts as A @@ -271,20 +272,44 @@ class SPV a where getOustandingBal :: a -> Balance +type BalDealStatMap = Map.Map DealStatFields Balance +type RDealStatMap = Map.Map DealStatFields Rate +type BDealStatMap = Map.Map DealStatFields Bool +type IDealStatMap = Map.Map DealStatFields Int + +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] + ,stats :: (BalDealStatMap,RDealStatMap,BDealStatMap,IDealStatMap) + ,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)) + ,ledgers :: Maybe (Map.Map String LD.Ledger) + } deriving (Show,Generic,Eq,Ord) + data UnderlyingDeal a = UnderlyingDeal { deal :: TestDeal a - ,futureCf :: Maybe CF.CashFlowFrame - ,futureScheduleCf :: Maybe CF.CashFlowFrame + ,futureCf :: CF.CashFlowFrame + ,futureScheduleCf :: CF.CashFlowFrame ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) } deriving (Generic,Eq,Ord,Show) -uDealFutureScheduleCf :: Ast.Asset a => Lens' (UnderlyingDeal a) (Maybe CF.CashFlowFrame) +uDealFutureScheduleCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame uDealFutureScheduleCf = lens getter setter where getter = futureScheduleCf setter ud newCf = ud {futureScheduleCf = newCf} -uDealFutureCf :: Ast.Asset a => Lens' (UnderlyingDeal a) (Maybe CF.CashFlowFrame) +uDealFutureCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame uDealFutureCf = lens getter setter where getter = futureCf @@ -293,45 +318,22 @@ uDealFutureCf = lens getter setter uDealFutureTxn :: Ast.Asset a => Lens' (UnderlyingDeal a) [CF.TsRow] uDealFutureTxn = lens getter setter where - getter ud = fromMaybe [] $ (view CF.cashflowTxn) <$> futureCf ud - setter ud newTxn = - let - mOriginalCfFrame = futureCf ud - - in - case mOriginalCfFrame of - Nothing -> ud {futureCf = Just (CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn)} - Just (CF.CashFlowFrame (begBal,begDate,mInt) txns) -> ud {futureCf = Just (CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn) } + getter ud = view CF.cashflowTxn $ futureCf ud + setter ud newTxn = ud {futureCf = CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn} + -- let + -- mOriginalCfFrame = futureCf ud + -- in + -- case mOriginalCfFrame of + -- + -- (CF.CashFlowFrame (begBal,begDate,mInt) txns) -> ud {futureCf = CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn } data PoolType a = MultiPool (Map.Map PoolId (P.Pool a)) | ResecDeal (Map.Map PoolId (UnderlyingDeal a)) deriving (Generic, Eq, Ord, Show) +makePrisms ''PoolType -type BalDealStatMap = Map.Map DealStatFields Balance -type RDealStatMap = Map.Map DealStatFields Rate -type BDealStatMap = Map.Map DealStatFields Bool -type IDealStatMap = Map.Map DealStatFields Int - -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] - ,stats :: (BalDealStatMap,RDealStatMap,BDealStatMap,IDealStatMap) - ,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)) - ,ledgers :: Maybe (Map.Map String LD.Ledger) - } deriving (Show,Generic,Eq,Ord) instance SPV (TestDeal a) where getBondsByName t bns @@ -504,7 +506,6 @@ dealPool = lens getter setter getter d = pool d setter d newPool = d {pool = newPool} - poolTypePool :: Ast.Asset a => Lens' (PoolType a) (Map.Map PoolId (P.Pool a)) poolTypePool = lens getter setter where @@ -517,42 +518,47 @@ poolTypeUnderDeal = lens getter setter getter = \case ResecDeal dm -> dm setter (ResecDeal dm) newDm = ResecDeal newDm -dealScheduledCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId (Maybe CF.CashFlowFrame)) -dealScheduledCashflow = lens getter setter - where - getter d = case pool d of - MultiPool pm -> Map.map P.futureScheduleCf pm - ResecDeal uds -> Map.map futureScheduleCf uds - x -> error $ "Failed to match :" ++ show x - setter d newCfMap = case pool d of - MultiPool pm -> let - newPm = Map.mapWithKey (\k p -> set P.poolFutureScheduleCf (newCfMap Map.! k) p) pm - in - set dealPool (MultiPool newPm) d - ResecDeal pm -> - let - newPm = Map.mapWithKey (\k ud -> - set uDealFutureScheduleCf (newCfMap Map.! k) ud) pm - in - set dealPool (ResecDeal newPm) d - -dealCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId (Maybe CF.CashFlowFrame)) -dealCashflow = lens getter setter - where - getter d = case pool d of - MultiPool pm -> Map.map P.futureCf pm - ResecDeal uds -> Map.map futureCf uds - setter d newCfMap = case pool d of - MultiPool pm -> let - newPm = Map.mapWithKey (\k p -> set P.poolFutureCf (newCfMap Map.! k) p) pm - in - set dealPool (MultiPool newPm) d - ResecDeal pm -> - let - newPm = Map.mapWithKey (\k ud -> - set uDealFutureCf (newCfMap Map.! k) ud) pm - in - set dealPool (ResecDeal newPm) d +-- schedulePoolFlowLens = poolTypePool . mapped . P.futureScheduleCfLens +-- schedulePoolFlowAggLens = schedulePoolFlowLens . _1 . _1 +-- scheduleBondFlowLens = poolTypeUnderDeal . mapped . uDealFutureScheduleCf + + +-- dealInputCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId CF.PoolCashflow) +-- dealInputCashflow = lens getter setter +-- where +-- getter d = case pool d of +-- MultiPool pm -> Map.map (P.futureScheduleCf) pm +-- ResecDeal uds -> Map.map futureScheduleCf uds +-- setter d newCfMap = case pool d of +-- MultiPool pm -> +-- let +-- newPm = Map.mapWithKey (\k p -> set (P.poolFutureScheduleCf) (newCfMap Map.! k) p) pm +-- in +-- set dealPool (MultiPool newPm) d +-- ResecDeal pm -> +-- let +-- newPm = Map.mapWithKey (\k ud ->gset uDealFutureScheduleCf (newCfMap Map.! k) ud) pm +-- in +-- set dealPool (ResecDeal newPm) d + +-- dealCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId (Maybe CF.CashFlowFrame)) +-- dealCashflow = lens getter setter +-- where +-- getter d = case pool d of +-- MultiPool pm -> Map.map P.futureCf pm +-- ResecDeal uds -> Map.map futureCf uds +-- setter d newCfMap = case pool d of +-- MultiPool pm -> let +-- newPm = Map.mapWithKey (\k p -> set P.poolFutureCf (newCfMap Map.! k) p) pm +-- in +-- set dealPool (MultiPool newPm) d +-- ResecDeal pm -> +-- let +-- newPm = Map.mapWithKey +-- (\k ud -> set uDealFutureCf (newCfMap Map.! k) ud) +-- pm +-- in +-- set dealPool (ResecDeal newPm) d getPoolIds :: Ast.Asset a => TestDeal a -> [PoolId] getPoolIds t@TestDeal{pool = pt} @@ -610,10 +616,12 @@ getAllAsset t@TestDeal{pool = pt} mPns = getAllAssetList :: Ast.Asset a => TestDeal a -> [a] getAllAssetList t = concat $ Map.elems (getAllAsset t Nothing) -getAllCollectedFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe CF.CashFlowFrame) -getAllCollectedFrame t mPid = +getAllCollectedFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId CF.CashFlowFrame +getAllCollectedFrame t@TestDeal{pool = poolType} mPid = let - mCf = view dealCashflow t + mCf = case poolType of + MultiPool pm -> Map.map (view (P.poolFutureCf . _1 )) pm -- `debug` ("MultiPool" ++ show pm) + ResecDeal uds -> Map.map futureCf uds in case mPid of Nothing -> mCf -- `debug` ("Nothing when collecting cfs"++show mCf) @@ -621,18 +629,17 @@ getAllCollectedFrame t mPid = getLatestCollectFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe CF.TsRow) getLatestCollectFrame t mPns = Map.map (\case - Nothing -> Nothing - (Just (CF.CashFlowFrame (_,_,_) [])) -> Nothing - (Just (CF.CashFlowFrame (_,_,_) txns)) -> Just $ last txns + (CF.CashFlowFrame (_,_,_) []) -> Nothing + (CF.CashFlowFrame (_,_,_) txns) -> Just $ last txns ) (getAllCollectedFrame t mPns) -getAllCollectedTxns :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe [CF.TsRow]) -getAllCollectedTxns t mPns = Map.map (view CF.cashflowTxn <$>) (getAllCollectedFrame t mPns) +getAllCollectedTxns :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId [CF.TsRow] +getAllCollectedTxns t mPns = Map.map (view CF.cashflowTxn) (getAllCollectedFrame t mPns) getAllCollectedTxnsList :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> [CF.TsRow] getAllCollectedTxnsList t mPns - = concat $ fromMaybe [] <$> listOfTxns + = concat listOfTxns where listOfTxns = Map.elems $ getAllCollectedTxns t mPns diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index 4f56de0e..cf0fd058 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -12,6 +12,7 @@ module Deal.DealQuery (queryDealBool ,patchDateToStats,patchDatesToStats,testPre import Deal.DealBase import Types import qualified Asset as P +import qualified AssetClass.AssetBase as AB import Data.List import Data.Fixed import Data.Maybe @@ -33,6 +34,7 @@ import qualified CreditEnhancement as CE import qualified Hedge as H import qualified Analytics as A import qualified Pool as Pl +import qualified InterestRate as IR import Stmt import Util import Errors @@ -269,6 +271,21 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f in Right $ sum rates + --TODO need to use projected current balance instead of current balance + PoolWaSpread mPns -> + let + assets = getAllAsset t mPns + bals = P.getCurrentBal <$> concat (Map.elems assets) + spreads = map + (\x -> + case x of + AB.MortgageOriginalInfo { AB.originRate = r } -> fromMaybe 0.0 $ IR._getSpread r + AB.LoanOriginalInfo { AB.originRate = r } -> fromMaybe 0.0 $ IR._getSpread r + _ -> 0.0) + (P.getOriginInfo <$> concat (Map.elems assets)) + in + Right $ weightedBy (toRational <$> bals) (toRational <$> spreads) + DealStatRate s -> case stats t of (_,m,_,_) -> case Map.lookup s m of @@ -283,6 +300,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f poolBn = maybe 0 (fromMaybe 0 . CF.mflowBorrowerNum) <$> poolCfs in Right . toRational $ sum poolBn + CurrentPoolBorrowerNum mPns -> let assetM = concat $ Map.elems $ getAllAsset t mPns @@ -296,7 +314,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f 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 + ProjCollectPeriodNum -> Right . toRational $ maximum' $ Map.elems $ Map.map CF.sizeCashFlowFrame $ getAllCollectedFrame t Nothing DealStatInt s -> case stats t of @@ -406,17 +424,17 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f Left $ "Date:"++show d++"Failed to find pool balance" ++ show pids ++ " from deal "++ show (Map.keys pm) _ -> Left $ "Date:"++show d++"Failed to find pool" ++ show mPns ++","++ show pt - FutureCurrentSchedulePoolBalance mPns -> - let - scheduleFlowM = Map.elems $ view dealScheduledCashflow t - in - Right . toRational $ sum $ maybe 0 ((view CF.tsRowBalance) . head . view CF.cashflowTxn) <$> scheduleFlowM - - FutureCurrentSchedulePoolBegBalance mPns -> - let - scheduleFlowM = Map.elems $ view dealScheduledCashflow t - in - Right . toRational $ sum $ maybe 0 (CF.mflowBegBalance . head . view CF.cashflowTxn) <$> scheduleFlowM +-- FutureCurrentSchedulePoolBalance mPns -> +-- let +-- scheduleFlowM = Map.elems $ view dealScheduledCashflow t +-- in +-- Right . toRational $ sum $ ((view CF.tsRowBalance) . head . view CF.cashflowTxn) <$> scheduleFlowM +-- +-- FutureCurrentSchedulePoolBegBalance mPns -> +-- let +-- scheduleFlowM = Map.elems $ view dealScheduledCashflow t +-- in +-- Right . toRational $ sum $ (CF.mflowBegBalance . head . view CF.cashflowTxn) <$> scheduleFlowM FutureCurrentPoolBegBalance mPns -> let @@ -428,7 +446,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f Right . toRational $ sum fieldAmts where mTxns = Map.elems $ getAllCollectedTxns t mPns - subflow = sliceBy EI fromDay asOfDay $ concat $ fromMaybe [] <$> mTxns + subflow = sliceBy EI fromDay asOfDay $ concat mTxns fieldAmts = map (`CF.lookupSource` incomeType) subflow CumulativePoolDefaultedBalance mPns -> @@ -453,7 +471,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f PoolCumCollection ps mPns -> let - collectedTxns = concat . Map.elems $ Map.map (fromMaybe []) $ getAllCollectedTxns t mPns + collectedTxns = concat . Map.elems $ getAllCollectedTxns t mPns futureVals = sum $ (CF.lookupSource <$> collectedTxns) <*> ps poolStats = Map.elems $ getIssuanceStats t mPns @@ -463,7 +481,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f PoolCumCollectionTill idx ps mPns -> let - txnMap = Map.map (dropLastN (negate idx) . fromMaybe []) $ getAllCollectedTxns t mPns + txnMap = Map.map (dropLastN (negate idx)) $ getAllCollectedTxns t mPns txnList = concat $ Map.elems txnMap lookupList = CF.lookupSource <$> txnList futureVals = sum $ lookupList <*> ps @@ -483,10 +501,9 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f let pCollectedTxns = getAllCollectedTxns t mPns pStat = Map.map - (\_x -> + (\x -> let lookupIndx = length x + idx - 1 - x = fromMaybe [] _x in if (( lookupIndx >= length x ) || (lookupIndx <0)) then Nothing @@ -509,8 +526,10 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f FuturePoolScheduleCfPv asOfDay pm mPns -> let - pScheduleFlow = view dealScheduledCashflow t - pCfTxns = Map.map (maybe [] (view CF.cashflowTxn)) $ + pScheduleFlow::(Map.Map PoolId CF.CashFlowFrame) = case pt of + MultiPool poolMap -> Map.map (\p -> view (Pl.poolFutureScheduleCf . _1) p) poolMap + -- ResecDeal dealMap -> Map.map (view uDealFutureScheduleCf) dealMap + pCfTxns::(Map.Map PoolId [CF.TsRow]) = Map.map (view CF.cashflowTxn) $ case mPns of Nothing -> pScheduleFlow Just pIds -> Map.filterWithKey (\k _ -> S.member k (S.fromList pIds)) pScheduleFlow @@ -710,11 +729,10 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f WeightedAvgCurrentPoolBalance d1 d2 mPns -> let - txnsByPool = getAllCollectedTxns t mPns - waBalByPool = Map.map (CF.mflowWeightAverageBalance d1 d2 <$>) txnsByPool + txnsByPool::(Map.Map PoolId [CF.TsRow]) = getAllCollectedTxns t mPns + waBalByPool::(Map.Map PoolId Balance) = Map.map (CF.mflowWeightAverageBalance d1 d2) txnsByPool in - Right . toRational $ - sum $ fromMaybe 0 <$> Map.elems waBalByPool + Right . toRational $ sum $ Map.elems waBalByPool WeightedAvgOriginalBondBalance d1 d2 bns -> let @@ -998,4 +1016,4 @@ preToStr t d p = ps = patchDateToStats d testPre2 :: P.Asset a => Date -> TestDeal a -> Pre -> (String, Either String Bool) -testPre2 d t p = (preToStr t d p, testPre d t p) \ No newline at end of file +testPre2 d t p = (preToStr t d p, testPre d t p) diff --git a/src/InterestRate.hs b/src/InterestRate.hs index 18f632aa..555de452 100644 --- a/src/InterestRate.hs +++ b/src/InterestRate.hs @@ -5,7 +5,8 @@ module InterestRate (ARM(..),RateType(..),runInterestRate2,runInterestRate,UseRate(..) - ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve, getSpread) + ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve + ,getSpread,_getSpread) where @@ -43,9 +44,9 @@ getDayCount :: RateType -> DayCount getDayCount (Fix dc _) = dc getDayCount (Floater dc _ _ _ _ _ _ _ ) = dc -getSpread :: RateType -> Maybe Spread -getSpread (Fix _ _) = Nothing -getSpread (Floater _ _ spd _ _ _ _ _) = Just spd +_getSpread :: RateType -> Maybe Spread +_getSpread (Fix _ _) = Nothing +_getSpread (Floater _ _ spd _ _ _ _ _) = Just spd data ARM = ARM InitPeriod InitCap PeriodicCap LifetimeCap RateFloor | OtherARM @@ -111,6 +112,7 @@ class UseRate x where getIndex :: x -> Maybe Index getIndexes :: x -> Maybe [Index] getResetDates :: x -> Dates + getSpread :: x -> Maybe Spread $(deriveJSON defaultOptions ''ARM) diff --git a/src/Pool.hs b/src/Pool.hs index d21d2f6e..a62d7f14 100644 --- a/src/Pool.hs +++ b/src/Pool.hs @@ -4,16 +4,17 @@ module Pool (Pool(..),aggPool ,getIssuanceField - ,poolFutureCf,poolFutureTxn,poolIssuanceStat + ,poolFutureCf,poolIssuanceStat ,poolFutureScheduleCf - ,poolBegStats,poolFutureCf2,calcLiquidationAmount,pricingPoolFlow + ,poolBegStats,calcLiquidationAmount,pricingPoolFlow + ,futureScheduleCfLens,futureCfLens, poolFutureCf ) where import Lib (Period(..) ,Ts(..),periodRateFromAnnualRate,toDate ,getIntervalDays,zipWith9,mkTs,periodsBetween - ,mkRateTs,daysBetween) + ,mkRateTs,daysBetween, ) import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) import qualified Assumptions as A @@ -32,7 +33,7 @@ import Data.Aeson.Types import Types hiding (Current) import Data.Maybe -import Control.Lens hiding (element) +import Control.Lens import Control.Lens.TH import Assumptions (ApplyAssumptionType) @@ -40,46 +41,31 @@ import Util import Cashflow (CashFlowFrame) import qualified Stmt as CF import Debug.Trace -debug = flip trace +gebug = flip trace data Pool a = Pool {assets :: [a] -- ^ a list of assets in the pool - ,futureCf :: Maybe CF.CashFlowFrame -- ^ projected cashflow from the assets in the pool - ,futureScheduleCf :: Maybe CF.CashFlowFrame -- ^ projected un-stressed cashflow + ,futureCf :: CF.PoolCashflow -- ^ collected cashflow from the assets in the pool + ,futureScheduleCf :: CF.PoolCashflow -- ^ collected un-stressed cashflow ,asOfDate :: Date -- ^ include cashflow after this date ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) -- ^ cutoff balance of pool ,extendPeriods :: Maybe DatePattern -- ^ dates for extend pool collection } deriving (Show, Generic, Ord, Eq) +makeLensesFor [("futureCf","futureCfLens"),("futureScheduleCf","futureScheduleCfLens")] ''Pool -poolFutureCf :: Asset a => Lens' (Pool a) (Maybe CF.CashFlowFrame) +poolFutureCf :: Asset a => Lens' (Pool a) CF.PoolCashflow poolFutureCf = lens getter setter where getter p = futureCf p setter p mNewCf = p {futureCf = mNewCf} -poolFutureCf2 :: Asset a => Lens' (Pool a) CF.CashFlowFrame -poolFutureCf2 = lens getter setter - where - getter p = fromMaybe (CF.CashFlowFrame (0,toDate "19000101",Nothing) []) $ futureCf p - setter p newCf = p {futureCf = Just newCf} - -poolFutureScheduleCf :: Asset a => Lens' (Pool a) (Maybe CF.CashFlowFrame) +poolFutureScheduleCf :: Asset a => Lens' (Pool a) CF.PoolCashflow poolFutureScheduleCf = lens getter setter where - getter p = futureScheduleCf p + getter p = futureScheduleCf p setter p mNewCf = p {futureScheduleCf = mNewCf} -poolFutureTxn :: Asset a => Lens' (Pool a) [CF.TsRow] -poolFutureTxn = lens getter setter - where - getter p = case futureCf p of - Nothing -> []::[CF.TsRow] - Just (CF.CashFlowFrame _ txns) -> txns - setter p trs = case futureCf p of - Nothing -> p {futureCf = Just (CF.CashFlowFrame (0,toDate "19000101",Nothing) trs)} --TODO fix this - Just (CF.CashFlowFrame st _) -> p {futureCf = Just (CF.CashFlowFrame st trs)} - poolIssuanceStat :: Asset a => Lens' (Pool a) (Map.Map CutoffFields Balance) poolIssuanceStat = lens getter setter where @@ -146,8 +132,8 @@ aggPool mStat xs calcLiquidationAmount :: Asset a => PricingMethod -> Pool a -> Date -> Amount calcLiquidationAmount (BalanceFactor currentFactor defaultFactor ) pool d = case futureCf pool of - Nothing -> 0 -- `debug` ("No futureCF") - Just _futureCf@(CF.CashFlowFrame _ trs) -> + (CF.CashFlowFrame _ [],_) -> 0 + _futureCf@(CF.CashFlowFrame _ trs,_) -> let earlierTxns = cutBy Inc Past d trs currentCumulativeDefaultBal = sum $ map (\x -> CF.mflowDefault x - CF.mflowRecovery x - CF.mflowLoss x) earlierTxns @@ -162,10 +148,10 @@ calcLiquidationAmount (BalanceFactor currentFactor defaultFactor ) pool d -- | pricing via future scheduled cashflow( zero risk adjust) -- | pricing via user define risk adjust cashflow( own assumption) -- TODO: in revolving buy future schedule cashflow should be updated as well -calcLiquidationAmount (PV discountRate recoveryPct) pool d +calcLiquidationAmount (PV discountRate recoveryPct) pool d = case futureCf pool of - Nothing -> 0 - Just (CF.CashFlowFrame _ trs) -> + (CF.CashFlowFrame _ [],_) -> 0 + (CF.CashFlowFrame _ trs,_) -> let futureTxns = cutBy Inc Future d trs -- `debug` (" pv date"++show d++ " with rate"++show discountRate) earlierTxns = cutBy Exc Past d trs -- `debug` ("Total txn"++show trs) @@ -177,22 +163,16 @@ calcLiquidationAmount (PV discountRate recoveryPct) pool d pvCf + mulBR currentDefaulBal recoveryPct -- ^ price a pool with collected cashflow and future cashflow -pricingPoolFlow :: Asset a => Date -> Pool a -> CashFlowFrame -> PricingMethod -> Amount -pricingPoolFlow d pool@Pool{ futureCf = mCollectedCf, issuanceStat = mStat } futureCfUncollected pm +pricingPoolFlow :: Asset a => Date -> Pool a -> CF.PoolCashflow -> PricingMethod -> Amount +pricingPoolFlow d pool@Pool{ futureCf = (mCollectedCf,_), issuanceStat = mStat } (futureCfUncollected,_) pm = let - currentCumulativeDefaultBal = case mCollectedCf of - Nothing -> 0 - Just collectedCf -> - let - collectedTxns = view CF.cashflowTxn collectedCf - in - if null collectedTxns then - 0 - else - let - lastTxn = last collectedTxns - in - fromMaybe 0 (CF.tsCumDefaultBal lastTxn) - fromMaybe 0 (CF.tsCumRecoveriesBal lastTxn) - fromMaybe 0 (CF.tsCumLossBal lastTxn) + currentCumulativeDefaultBal + | CF.emptyCashFlowFrame mCollectedCf = 0 + | otherwise = let + lastTxn = last $ view CF.cashflowTxn $ mCollectedCf + in + fromMaybe 0 (CF.tsCumDefaultBal lastTxn) - fromMaybe 0 (CF.tsCumRecoveriesBal lastTxn) - fromMaybe 0 (CF.tsCumLossBal lastTxn) + currentPerformingBal = case mStat of Nothing -> 0 Just stat -> Map.findWithDefault 0 RuntimeCurrentPoolBalance stat diff --git a/src/Types.hs b/src/Types.hs index d985753d..d4868a32 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -541,7 +541,6 @@ data Pre = IfZero DealStats deriving (Show,Generic,Eq,Ord,Read) - data Table a b = ThresholdTable [(a,b)] deriving (Show,Eq,Ord,Read,Generic) @@ -618,6 +617,7 @@ data DealStats = CurrentBondBalance | PoolCumCollectionTill Int [PoolSource] (Maybe [PoolId]) | PoolCurCollection [PoolSource] (Maybe [PoolId]) | PoolCollectionStats Int [PoolSource] (Maybe [PoolId]) + | PoolWaSpread (Maybe [PoolId]) | AllAccBalance | AccBalance [AccName] | LedgerBalance [String] @@ -780,6 +780,7 @@ data CashflowReport = CashflowReport { ,endDate :: Date } deriving (Show,Read,Generic,Eq) + data Threshold = Below | EqBelow | Above @@ -792,20 +793,21 @@ data SplitType = EqToLeft -- if equal, the element belongs to left | EqToLeftKeepOnes deriving (Show, Eq, Generic) -data CutoffFields = IssuanceBalance -- ^ pool issuance balance - | HistoryRecoveries -- ^ cumulative recoveries - | HistoryInterest -- ^ cumulative interest collected - | HistoryPrepayment -- ^ cumulative prepayment collected +-- ^ deal level cumulative statistics +data CutoffFields = IssuanceBalance -- ^ pool issuance balance + | HistoryRecoveries -- ^ cumulative recoveries + | HistoryInterest -- ^ cumulative interest collected + | HistoryPrepayment -- ^ cumulative prepayment collected | HistoryPrepaymentPentalty -- ^ cumulative prepayment collected - | HistoryPrincipal -- ^ cumulative principal collected - | HistoryRental -- ^ cumulative rental collected - | HistoryDefaults -- ^ cumulative default balance - | HistoryDelinquency -- ^ cumulative delinquency balance - | HistoryLoss -- ^ cumulative loss/write-off balance - | HistoryCash -- ^ cumulative cash + | HistoryPrincipal -- ^ cumulative principal collected + | HistoryRental -- ^ cumulative rental collected + | HistoryDefaults -- ^ cumulative default balance + | HistoryDelinquency -- ^ cumulative delinquency balance + | HistoryLoss -- ^ cumulative loss/write-off balance + | HistoryCash -- ^ cumulative cash | HistoryFeePaid - | AccruedInterest -- ^ accrued interest at closing - | RuntimeCurrentPoolBalance -- ^ current pool balance + | AccruedInterest -- ^ accrued interest at closing + | RuntimeCurrentPoolBalance -- ^ current pool balance deriving (Show,Ord,Eq,Read,Generic,NFData) @@ -902,9 +904,6 @@ instance TimeSeries (TsPoint a) where getDate (TsPoint d a) = d - -- compare (PoolPeriodPoint i1 tv1) (PoolPeriodPoint i2 tv2) = compare i1 i2 - - $(deriveJSON defaultOptions ''DecimalRaw) $(deriveJSON defaultOptions ''TsPoint) $(deriveJSON defaultOptions ''PerPoint) @@ -1092,6 +1091,7 @@ getDealStatType (Avg dss) = RtnRate getDealStatType (Divide ds1 ds2) = RtnRate getDealStatType (Multiply _) = RtnRate getDealStatType (Factor _ _) = RtnRate +getDealStatType (PoolWaSpread _) = RtnRate getDealStatType (CurrentPoolBorrowerNum _) = RtnInt getDealStatType (MonthsTillMaturity _) = RtnInt @@ -1144,13 +1144,9 @@ instance FromJSONKey DateType where $(deriveJSON defaultOptions ''RangeType) --- $(deriveJSON defaultOptions ''(PerCurve Balance)) --- $(deriveJSON defaultOptions ''(PerCurve Rate)) $(deriveJSON defaultOptions ''PerCurve) $(deriveJSON defaultOptions ''Pre) - $(deriveJSON defaultOptions ''CustomDataType) - $(deriveJSON defaultOptions ''ActionWhen) instance ToJSONKey ActionWhen where @@ -1215,4 +1211,4 @@ $(deriveJSON defaultOptions ''RateAssumption) $(deriveJSON defaultOptions ''Direction) makePrisms ''Txn -$(concat <$> traverse (deriveJSON defaultOptions) [''Limit] ) \ No newline at end of file +$(concat <$> traverse (deriveJSON defaultOptions) [''Limit] ) diff --git a/swagger.json b/swagger.json index f0baaf43..8230417d 100644 --- a/swagger.json +++ b/swagger.json @@ -2478,14 +2478,14 @@ { "properties": { "contents": { - "items": { - "$ref": "#/components/schemas/ObligorStrategy" + "additionalProperties": { + "$ref": "#/components/schemas/ApplyAssumptionType" }, - "type": "array" + "type": "object" }, "tag": { "enum": [ - "ByObligor" + "ByPoolId" ], "type": "string" } @@ -2494,20 +2494,20 @@ "tag", "contents" ], - "title": "ByObligor", + "title": "ByPoolId", "type": "object" }, { "properties": { "contents": { - "additionalProperties": { - "$ref": "#/components/schemas/ApplyAssumptionType" + "items": { + "$ref": "#/components/schemas/ObligorStrategy" }, - "type": "object" + "type": "array" }, "tag": { "enum": [ - "ByPoolId" + "ByObligor" ], "type": "string" } @@ -2516,7 +2516,7 @@ "tag", "contents" ], - "title": "ByPoolId", + "title": "ByObligor", "type": "object" }, { @@ -6052,6 +6052,28 @@ "title": "PoolCollectionStats", "type": "object" }, + { + "properties": { + "contents": { + "items": { + "$ref": "#/components/schemas/PoolId" + }, + "type": "array" + }, + "tag": { + "enum": [ + "PoolWaSpread" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "PoolWaSpread", + "type": "object" + }, { "properties": { "tag": { @@ -9172,7 +9194,7 @@ ], "type": "string" }, - "Either_[Char]_((CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))),(Maybe_[PriceResult]))": { + "Either_[Char]_(CashFlowFrame,(Maybe_[PriceResult]))": { "oneOf": [ { "properties": { @@ -9191,21 +9213,7 @@ "Right": { "items": [ { - "items": [ - { - "$ref": "#/components/schemas/CashFlowFrame" - }, - { - "additionalProperties": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "type": "object" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" + "$ref": "#/components/schemas/CashFlowFrame" }, { "items": { @@ -9280,7 +9288,7 @@ } ] }, - "Either_[Char]_(Map_PoolId_(CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))))": { + "Either_[Char]_(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame])))": { "oneOf": [ { "properties": { @@ -9303,11 +9311,10 @@ "$ref": "#/components/schemas/CashFlowFrame" }, { - "additionalProperties": { - "multipleOf": 1.0e-2, - "type": "number" + "items": { + "$ref": "#/components/schemas/CashFlowFrame" }, - "type": "object" + "type": "array" } ], "maxItems": 2, @@ -9382,6 +9389,13 @@ } ] }, + "ExpectReturn": { + "enum": [ + "DealLogs", + "AssetLevelFlow" + ], + "type": "string" + }, "ExtraStress": { "properties": { "defaultFactors": { @@ -12855,10 +12869,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -12870,6 +12910,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -12889,10 +12931,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -12904,6 +12972,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -12923,10 +12993,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -12938,6 +13034,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -12957,10 +13055,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -12972,6 +13096,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -12991,10 +13117,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13006,6 +13158,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13025,10 +13179,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13040,6 +13220,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13059,10 +13241,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13074,6 +13282,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13093,10 +13303,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13108,6 +13344,8 @@ }, "required": [ "assets", + "futureCf", + "futureScheduleCf", "asOfDate" ], "type": "object" @@ -16092,10 +16330,16 @@ }, { "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, { @@ -16134,10 +16378,16 @@ }, { "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, { @@ -16182,10 +16432,16 @@ }, { "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, { @@ -16231,10 +16487,16 @@ }, { "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" } ], @@ -16607,6 +16869,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "$ref": "#/components/schemas/DealType" }, @@ -16617,8 +16885,8 @@ "$ref": "#/components/schemas/NonPerfAssumption" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16639,6 +16907,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "$ref": "#/components/schemas/DealType" }, @@ -16652,8 +16926,8 @@ "$ref": "#/components/schemas/NonPerfAssumption" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16674,6 +16948,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "additionalProperties": { "$ref": "#/components/schemas/DealType" @@ -16687,8 +16967,8 @@ "$ref": "#/components/schemas/NonPerfAssumption" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16709,6 +16989,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "$ref": "#/components/schemas/DealType" }, @@ -16722,8 +17008,8 @@ "type": "object" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16744,6 +17030,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "additionalProperties": { "$ref": "#/components/schemas/DealType" @@ -16763,8 +17055,8 @@ "type": "object" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16789,6 +17081,9 @@ "properties": { "contents": { "items": [ + { + "type": "boolean" + }, { "$ref": "#/components/schemas/PoolTypeWrap" }, @@ -16802,8 +17097,8 @@ "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16824,6 +17119,9 @@ "properties": { "contents": { "items": [ + { + "type": "boolean" + }, { "$ref": "#/components/schemas/PoolTypeWrap" }, @@ -16840,8 +17138,8 @@ "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -20575,7 +20873,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20599,7 +20899,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20623,7 +20925,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20647,7 +20951,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20671,7 +20977,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20695,7 +21003,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20719,7 +21029,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20743,7 +21055,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20786,7 +21100,7 @@ "content": { "application/json;charset=utf-8": { "schema": { - "$ref": "#/components/schemas/Either_[Char]_((CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))),(Maybe_[PriceResult]))" + "$ref": "#/components/schemas/Either_[Char]_(CashFlowFrame,(Maybe_[PriceResult]))" } } }, @@ -21025,7 +21339,7 @@ "content": { "application/json;charset=utf-8": { "schema": { - "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))))" + "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame])))" } } }, @@ -21054,7 +21368,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))))" + "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame])))" }, "type": "object" } diff --git a/test/DealTest/DealTest.hs b/test/DealTest/DealTest.hs index 12e22fb4..da08b31b 100644 --- a/test/DealTest/DealTest.hs +++ b/test/DealTest/DealTest.hs @@ -96,7 +96,7 @@ baseCase = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=Just (CF.CashFlowFrame dummySt []) + ,P.futureCf=(CF.CashFlowFrame dummySt [], Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance, 4000)] ,P.extendPeriods = Nothing}))]) @@ -116,7 +116,7 @@ baseCase = D.TestDeal { baseTests = let nonRunAssump = (AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just [AP.InspectPt MonthEnd (FutureCurrentPoolBalance Nothing)]) Nothing Nothing Nothing Nothing Nothing Nothing) - (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase DealPoolFlowPricing Nothing nonRunAssump of + (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Left e -> error $ "Deal run failed"++ show e Right x -> x inspects = [ rc | rc@(InspectBal {}) <- rcs ] diff --git a/test/DealTest/MultiPoolDealTest.hs b/test/DealTest/MultiPoolDealTest.hs index e33a5404..61c5167d 100644 --- a/test/DealTest/MultiPoolDealTest.hs +++ b/test/DealTest/MultiPoolDealTest.hs @@ -38,7 +38,7 @@ dummySt = (0,Lib.toDate "19000101",Nothing) multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 1000 0.085 60 Nothing AB.Current] - ,P.futureCf= Nothing + ,P.futureCf= (CF.emptyCashflow,Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,1000)] ,P.extendPeriods = Nothing @@ -46,7 +46,7 @@ multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage ,(PoolName "PoolB",(P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 3000 0.085 60 Nothing AB.Current] - ,P.futureCf=Just (CF.CashFlowFrame dummySt []) + ,P.futureCf=(CF.CashFlowFrame dummySt [],Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,3000)] ,P.extendPeriods = Nothing}))] @@ -107,7 +107,7 @@ mPoolbaseTests = ,FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])] ] nonRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just inspectVars) Nothing Nothing Nothing Nothing Nothing Nothing - (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase DealPoolFlowPricing Nothing nonRunAssump of + (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Right x -> x Left y -> error ("Error in running deal"++ show y) inspects = [ rc | rc@(InspectBal {}) <- rcs ] diff --git a/test/DealTest/ResecDealTest.hs b/test/DealTest/ResecDealTest.hs index 64d7963a..5734a1f4 100644 --- a/test/DealTest/ResecDealTest.hs +++ b/test/DealTest/ResecDealTest.hs @@ -78,7 +78,7 @@ baseCase = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=Just (CF.CashFlowFrame dummySt []) + ,P.futureCf=(CF.CashFlowFrame dummySt [],Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Nothing ,P.extendPeriods = Nothing}))]) @@ -121,7 +121,7 @@ resecDeal = D.TestDeal { ] ) ,D.pool = D.ResecDeal (Map.fromList [(DealBondFlow "base case" "A" (toDate "20200101") 0.25 - , D.UnderlyingDeal baseCase Nothing Nothing Nothing)]) + , D.UnderlyingDeal baseCase CF.emptyCashflow CF.emptyCashflow Nothing)]) ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [ (W.PayInt Nothing "General" ["A"] Nothing) ,(W.PayPrin Nothing "General" ["A"] Nothing) diff --git a/test/DealTest/RevolvingTest.hs b/test/DealTest/RevolvingTest.hs index 1dcde93e..ced1ee07 100644 --- a/test/DealTest/RevolvingTest.hs +++ b/test/DealTest/RevolvingTest.hs @@ -36,7 +36,7 @@ import Control.Lens.TH multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 1000 0.085 60 Nothing AB.Current] - ,P.futureCf= Nothing + ,P.futureCf= (CF.emptyCashflow, Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,1000)] ,P.extendPeriods = Nothing @@ -44,7 +44,7 @@ multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage ,(PoolName "PoolB",(P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 3000 0.085 60 Nothing AB.Current] - ,P.futureCf= Nothing + ,P.futureCf= (CF.emptyCashflow, Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,3000)] ,P.extendPeriods = Nothing}))] @@ -118,7 +118,7 @@ baseTests = ,FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])] ] nonRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing rAssump Nothing (Just inspectVars) Nothing Nothing Nothing Nothing Nothing Nothing - (dealAfterRun,poolCf,_,_) = case DR.runDeal baseCase DealPoolFlowPricing Nothing nonRunAssump of + (dealAfterRun,poolCf,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Right x -> x Left y -> error ("Error in running deal"++ show y) in diff --git a/test/UT/AccountTest.hs b/test/UT/AccountTest.hs index ceb1fef3..c4c56bc0 100644 --- a/test/UT/AccountTest.hs +++ b/test/UT/AccountTest.hs @@ -87,7 +87,7 @@ reserveAccTest = ,CF.MortgageFlow (toDate "20220801") 110 20 10 0 0 0 0 0 Nothing Nothing Nothing ,CF.MortgageFlow (toDate "20220901") 90 20 10 0 0 0 0 0 Nothing Nothing Nothing ,CF.MortgageFlow (toDate "20221001") 70 20 10 0 0 0 0 0 Nothing Nothing Nothing] - ttd = set (dealPool . poolTypePool . (ix PoolConsol) . P.poolFutureCf) (Just testCFs) td2 {accounts = accMap} + ttd = set (dealPool . poolTypePool . (ix PoolConsol) . P.poolFutureCf) (testCFs, Nothing) td2 {accounts = accMap} in testGroup "Test On Reserve Acc" [ diff --git a/test/UT/AssetTest.hs b/test/UT/AssetTest.hs index a6d5aac5..36114b18 100644 --- a/test/UT/AssetTest.hs +++ b/test/UT/AssetTest.hs @@ -626,8 +626,8 @@ delinqScheduleCFTest = ,CF.MortgageDelinqFlow (L.toDate "20231001") 500 500 0 0 0 0 0 0 0.08 Nothing Nothing Nothing ] pool = P.Pool ([]::[AB.Mortgage]) - (Just (CF.CashFlowFrame dummySt cfs)) - (Just (CF.CashFlowFrame dummySt cfs)) + ((CF.CashFlowFrame dummySt cfs), Nothing) + ((CF.CashFlowFrame dummySt cfs), Nothing) (L.toDate "20230801") Nothing (Just MonthEnd) @@ -941,4 +941,4 @@ fixedAssetTest = -- in -- ((`CF.cfAt` 9) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") -- ((A.FixedAssetAssump utilCurve priceCurve Nothing) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing)))) - ] \ No newline at end of file + ] diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs index 14627d60..eb2d7b26 100644 --- a/test/UT/DealTest.hs +++ b/test/UT/DealTest.hs @@ -138,7 +138,7 @@ td2 = D.TestDeal { Nothing (AB.Defaulted Nothing) ] - ,P.futureCf=Nothing + ,P.futureCf=(CF.emptyCashflow, Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(RuntimeCurrentPoolBalance, 70)]} )] @@ -250,7 +250,7 @@ baseDeal = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=Nothing + ,P.futureCf= (CF.emptyCashflow, Nothing) ,P.extendPeriods = Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(RuntimeCurrentPoolBalance, 70),(IssuanceBalance, 4000)]})] @@ -269,7 +269,7 @@ baseDeal = D.TestDeal { poolFlowTest = let - (deal,mPoolCf,mResultComp,mPricing) = case (runDeal baseDeal DealPoolFlowPricing Nothing emptyRunAssump) of + (deal,mPoolCf,mResultComp,mPricing) = case (runDeal baseDeal S.empty Nothing emptyRunAssump) of (Left er) -> error $ "Deal run failed"++ show er (Right (a,b,c,d)) -> (a,b,c,d) bndMap = D.viewBondsInMap deal @@ -279,7 +279,7 @@ poolFlowTest = testCase "pool begin flow" $ assertEqual "pool size should be 60" (Just (Map.fromList [(PoolConsol ,60)])) - ( (\m -> Map.map CF.sizeCashFlowFrame m) <$> mPoolCf ) -- `debug` ("pool "++ show (mPoolCf)) + ( (\m -> Map.map CF.sizeCashFlowFrame m) <$> mPoolCf ) `debug` ("pool from test "++ show (mPoolCf)) ,testCase "total principal bal" $ assertEqual "pool bal should equal to total collect" @@ -305,7 +305,7 @@ queryTests = testGroup "deal stat query Tests" triggerTests = testGroup "Trigger Tests" [ let setup = 0 - poolflows = CF.CashFlowFrame dummySt $ + poolflows = (CF.CashFlowFrame dummySt $ [CF.MortgageDelinqFlow (toDate "20220201") 800 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ,CF.MortgageDelinqFlow (toDate "20220301") 700 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ,CF.MortgageDelinqFlow (toDate "20220401") 600 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing @@ -313,6 +313,7 @@ triggerTests = testGroup "Trigger Tests" ,CF.MortgageDelinqFlow (toDate "20220601") 400 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ,CF.MortgageDelinqFlow (toDate "20220701") 300 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ] + ,Nothing) poolflowM = Map.fromList [(PoolConsol, poolflows)] ads = [PoolCollection (toDate "20220201") "" ,RunWaterfall (toDate "20220225") "" diff --git a/test/UT/DealTest2.hs b/test/UT/DealTest2.hs index 58b1aa37..84556033 100644 --- a/test/UT/DealTest2.hs +++ b/test/UT/DealTest2.hs @@ -121,7 +121,7 @@ td = D.TestDeal { Nothing (AB.Defaulted Nothing) ] - ,P.futureCf=Nothing + ,P.futureCf=(CF.CashFlowFrame (0,epocDate,Nothing) [],Nothing) ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Nothing} )] From d249385ec8437c6f4ab8a44fb8e9494281044b53 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Tue, 1 Jul 2025 17:37:22 +0800 Subject: [PATCH 20/49] Init test 01 --- src/Cashflow.hs | 8 ++++++++ src/Deal.hs | 14 +++++++------- src/Deal/DealAction.hs | 2 +- src/Deal/DealQuery.hs | 2 +- src/Pool.hs | 4 ++-- swagger.json | 8 -------- test/UT/AssetTest.hs | 2 +- 7 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/Cashflow.hs b/src/Cashflow.hs index 9a0154e4..7dc6a674 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -76,6 +76,14 @@ type AssetCashflow = CashFlowFrame type PoolCashflow = (AssetCashflow, Maybe [AssetCashflow]) emptyCashflow = CashFlowFrame (0,epocDate,Nothing) [] + +instance Monoid CashFlowFrame where + mempty = emptyCashflow + +instance Semigroup CashFlowFrame where + CashFlowFrame (begBal1, begDate1, mAccInt1) ts1 <> CashFlowFrame (begBal2, begDate2, mAccInt2) ts2 + = CashFlowFrame (begBal1,begDate1,mAccInt1) (ts1 <> ts2) + opStats :: (Balance -> Balance -> Balance) -> Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat opStats op (Just (a1,b1,c1,d1,e1,f1)) (Just (a2,b2,c3,d2,e2,f2)) = Just (op a1 a2,op b1 b2,op c1 c3,op d1 d2,op e1 e2,op f1 f2) opStats op Nothing Nothing = Nothing diff --git a/src/Deal.hs b/src/Deal.hs index 79adb9a9..9f7b5d7d 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -403,7 +403,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= poolFlowMap (Just (ad:ads)) rates calls rAssump log | all (== 0) futureCashToCollect && (queryCompound t (getDate ad) AllAccBalance == Right 0) && (dStatus /= Revolving) && (dStatus /= Warehousing Nothing) --TODO need to use prsim here to cover all warehouse status = do - let runContext = RunContext poolFlowMap rAssump rates `debug` ("ending at date " ++ show (getDate ad)) + let runContext = RunContext poolFlowMap rAssump rates --- `debug` ("ending at date " ++ show (getDate ad)) (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions return (finalDeal, (DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving"))) -- `debug` ("End of pool collection with logs with length "++ show (length log)) @@ -429,7 +429,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= let newPt = case (pool dAfterDeposit) of MultiPool pm -> MultiPool $ Map.map - (\p -> over (P.poolFutureScheduleCf . _1 . CF.cashflowTxn) (cutBy Exc Future d) p) + (\p -> over (P.poolFutureScheduleCf . _Just . _1 . CF.cashflowTxn) (cutBy Exc Future d) p) pm ResecDeal dMap -> ResecDeal dMap let runContext = RunContext outstandingFlow rAssump rates -- `debug` ("PoolCollection: before rc >>"++ show d++">>>"++ show (pool dAfterDeposit)) @@ -673,7 +673,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= MakeWhole d spd walTbl -> let schedulePoolFlowMap = case pt of - MultiPool pMap -> Map.map (fst . P.futureScheduleCf) pMap + MultiPool pMap -> Map.map (view (P.poolFutureScheduleCf._Just._1) ) pMap ResecDeal uDealMap -> Map.map (view uDealFutureScheduleCf) uDealMap in do @@ -1150,10 +1150,10 @@ runPool (P.Pool as _ _ asof _ _) Nothing mRates return [ (x, Map.empty) | x <- cf ] -- asset cashflow with credit stress ---- By pool level -runPool (P.Pool as (CF.CashFlowFrame _ [],_) (CF.CashFlowFrame _ [],_) asof _ _) (Just (AP.PoolLevel assumps)) mRates +runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates = sequenceA $ parMap rdeepseq (\x -> Ast.projCashflow x asof assumps mRates) as ---- By index -runPool (P.Pool as (CF.CashFlowFrame _ [],_) (CF.CashFlowFrame _ [],_) asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = +runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = let numAssets = length as in @@ -1162,7 +1162,7 @@ runPool (P.Pool as (CF.CashFlowFrame _ [],_) (CF.CashFlowFrame _ [],_) asof _ _ sequenceA $ parMap rdeepseq (\(x, a) -> Ast.projCashflow x asof a mRates) (zip as _assumps) ---- By Obligor -runPool (P.Pool as (CF.CashFlowFrame _ [],_) (CF.CashFlowFrame _ [],_) asof _ _) (Just (AP.ByObligor obligorRules)) mRates = +runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = let -- result cf,rules,assets -- matchAssets:: Ast.Asset c => [Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> [AP.ObligorStrategy] @@ -1265,7 +1265,7 @@ patchIssuanceBalance _ bal p = p -- `debug` ("NO patching ?") patchScheduleFlow :: Ast.Asset a => Map.Map PoolId CF.PoolCashflow -> PoolType a -> PoolType a patchScheduleFlow flowM pt = case pt of - MultiPool pM -> MultiPool $ Map.intersectionWith (set P.poolFutureScheduleCf) flowM pM + MultiPool pM -> MultiPool $ Map.intersectionWith (set (P.poolFutureScheduleCf . _Just)) flowM pM ResecDeal pM -> ResecDeal pM patchRuntimeBal :: Ast.Asset a => Map.Map PoolId Balance -> PoolType a -> PoolType a diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index f2d9406b..2fbd3ff4 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -623,7 +623,7 @@ performActionWrap d (W.LiquidatePool lm an mPid) = let liqFunction = \(p@P.Pool{ P.issuanceStat = m} ) - -> over (P.poolFutureScheduleCf . _1) (CF.extendCashFlow d) $ + -> over (P.poolFutureScheduleCf . _Just . _1) (CF.extendCashFlow d) $ over (P.poolFutureCf . _1 ) (CF.extendCashFlow d) $ p { P.issuanceStat = Just (Map.insert RuntimeCurrentPoolBalance 0 (fromMaybe Map.empty m)) } diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index cf0fd058..315716dc 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -527,7 +527,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f FuturePoolScheduleCfPv asOfDay pm mPns -> let pScheduleFlow::(Map.Map PoolId CF.CashFlowFrame) = case pt of - MultiPool poolMap -> Map.map (\p -> view (Pl.poolFutureScheduleCf . _1) p) poolMap + MultiPool poolMap -> Map.map (\p -> view (Pl.poolFutureScheduleCf . _Just . _1) p) poolMap -- ResecDeal dealMap -> Map.map (view uDealFutureScheduleCf) dealMap pCfTxns::(Map.Map PoolId [CF.TsRow]) = Map.map (view CF.cashflowTxn) $ case mPns of diff --git a/src/Pool.hs b/src/Pool.hs index a62d7f14..0b73be07 100644 --- a/src/Pool.hs +++ b/src/Pool.hs @@ -46,7 +46,7 @@ gebug = flip trace data Pool a = Pool {assets :: [a] -- ^ a list of assets in the pool ,futureCf :: CF.PoolCashflow -- ^ collected cashflow from the assets in the pool - ,futureScheduleCf :: CF.PoolCashflow -- ^ collected un-stressed cashflow + ,futureScheduleCf :: Maybe CF.PoolCashflow -- ^ collected un-stressed cashflow ,asOfDate :: Date -- ^ include cashflow after this date ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) -- ^ cutoff balance of pool ,extendPeriods :: Maybe DatePattern -- ^ dates for extend pool collection @@ -60,7 +60,7 @@ poolFutureCf = lens getter setter getter p = futureCf p setter p mNewCf = p {futureCf = mNewCf} -poolFutureScheduleCf :: Asset a => Lens' (Pool a) CF.PoolCashflow +poolFutureScheduleCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow) poolFutureScheduleCf = lens getter setter where getter p = futureScheduleCf p diff --git a/swagger.json b/swagger.json index 8230417d..8f5e3bba 100644 --- a/swagger.json +++ b/swagger.json @@ -12911,7 +12911,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" @@ -12973,7 +12972,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13035,7 +13033,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13097,7 +13094,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13159,7 +13155,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13221,7 +13216,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13283,7 +13277,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" @@ -13345,7 +13338,6 @@ "required": [ "assets", "futureCf", - "futureScheduleCf", "asOfDate" ], "type": "object" diff --git a/test/UT/AssetTest.hs b/test/UT/AssetTest.hs index 36114b18..3d8d6435 100644 --- a/test/UT/AssetTest.hs +++ b/test/UT/AssetTest.hs @@ -627,7 +627,7 @@ delinqScheduleCFTest = ] pool = P.Pool ([]::[AB.Mortgage]) ((CF.CashFlowFrame dummySt cfs), Nothing) - ((CF.CashFlowFrame dummySt cfs), Nothing) + Nothing (L.toDate "20230801") Nothing (Just MonthEnd) From 1fe1e803185beb2c361a8b9394b755192e9e09d3 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Wed, 2 Jul 2025 01:12:28 +0800 Subject: [PATCH 21/49] make futureCf as Maybe --- src/Deal.hs | 37 ++++++++++++++++++------------ src/Deal/DealAction.hs | 2 +- src/Deal/DealBase.hs | 2 +- src/Pool.hs | 16 ++++++------- test/DealTest/DealTest.hs | 2 +- test/DealTest/MultiPoolDealTest.hs | 4 ++-- test/DealTest/ResecDealTest.hs | 2 +- test/DealTest/RevolvingTest.hs | 4 ++-- test/UT/AccountTest.hs | 2 +- test/UT/AssetTest.hs | 6 ++--- test/UT/DealTest.hs | 6 ++--- test/UT/DealTest2.hs | 2 +- 12 files changed, 46 insertions(+), 39 deletions(-) diff --git a/src/Deal.hs b/src/Deal.hs index 9f7b5d7d..f7e4edb4 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -429,7 +429,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= let newPt = case (pool dAfterDeposit) of MultiPool pm -> MultiPool $ Map.map - (\p -> over (P.poolFutureScheduleCf . _Just . _1 . CF.cashflowTxn) (cutBy Exc Future d) p) + (over (P.poolFutureScheduleCf . _Just . _1 . CF.cashflowTxn) (cutBy Exc Future d)) pm ResecDeal dMap -> ResecDeal dMap let runContext = RunContext outstandingFlow rAssump rates -- `debug` ("PoolCollection: before rc >>"++ show d++">>>"++ show (pool dAfterDeposit)) @@ -1062,9 +1062,9 @@ prepareDeal er t@TestDeal {bonds = bndMap ,pool = poolType } | otherwise = [] in t {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap - ,pool = poolType & over (_MultiPool . mapped . P.poolFutureCf ._1) consolePoolFlowFn + ,pool = poolType & over (_MultiPool . mapped . P.poolFutureCf . _Just ._1) consolePoolFlowFn & over (_ResecDeal . mapped . uDealFutureCf) consolePoolFlowFn - & over (_MultiPool . mapped . P.poolFutureCf . _2 . _Just) rmAssetLevelFn + & over (_MultiPool . mapped . P.poolFutureCf . _Just . _2 . _Just) rmAssetLevelFn } @@ -1076,9 +1076,9 @@ appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap MultiPool poolM -> MultiPool $ Map.foldrWithKey - (\k (CF.CashFlowFrame _ txnCollected, mAssetFlow) acc -> + (\k (CF.CashFlowFrame st txnCollected, mAssetFlow) acc -> let - currentStats = case view (P.poolFutureCf . _1 . CF.cashflowTxn) (acc Map.! k) of + currentStats = case view (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (acc Map.! k) of [] -> P.poolBegStats (acc Map.! k) txns -> fromMaybe (0,0,0,0,0,0) $ view CF.txnCumulativeStats (last txns) balInCollected = case length txnCollected of @@ -1086,7 +1086,16 @@ appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap _ -> view CF.tsRowBalance $ last txnCollected txnToAppend = CF.patchCumulative currentStats [] txnCollected -- insert aggregated pool flow - accUpdated = acc & ix k %~ over (P.poolFutureCf . _1 . CF.cashflowTxn) (++ txnToAppend) + accUpdated = Map.adjust + (\_v -> case (P.futureCf _v) of + Nothing -> set P.poolFutureCf (Just (CF.CashFlowFrame st txnCollected , mAssetFlow)) _v + Just _ -> over (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (++ txnToAppend) _v + ) + k + acc + -- & ix k %~ over (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (++ txnToAppend) + -- & ix k %~ over (P.poolFutureCf . _Nothing) (\ () -> Just (CF.CashFlowFrame st txnCollected , mAssetFlow)) + -- insert breakdown asset flow accUpdated' = case mAssetFlow of Nothing -> accUpdated @@ -1102,7 +1111,7 @@ appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip (cfs++dummyCashFrames) collectedAssetFlow ] | otherwise = error "incomping cashflow number shall greater than existing cashflow number" in - accUpdated & ix k %~ (\p -> over (P.poolFutureCf . _2) appendFn p) + accUpdated & ix k %~ (over (P.poolFutureCf . _Just . _2) appendFn) in Map.adjust (over P.poolIssuanceStat (Map.insert RuntimeCurrentPoolBalance balInCollected)) @@ -1124,7 +1133,7 @@ removePoolCf :: Ast.Asset a => TestDeal a -> TestDeal a removePoolCf t@TestDeal{pool=pt} = let newPt = case pt of - MultiPool pm -> MultiPool $ set (mapped . P.poolFutureCf) (CF.CashFlowFrame (0,epocDate,Nothing) [], Nothing) pm + MultiPool pm -> MultiPool $ set (mapped . P.poolFutureCf) Nothing pm ResecDeal uds -> ResecDeal uds _ -> error $ "not implement:" ++ show pt in @@ -1135,9 +1144,9 @@ removePoolCf t@TestDeal{pool=pt} = 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 [] (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 [] ((CF.CashFlowFrame _ txn),_) _ asof _ (Just dp)) (Just (AP.PoolLevel assumps)) mRates +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") -- project contractual cashflow if nothing found in pool perf assumption @@ -1150,10 +1159,10 @@ runPool (P.Pool as _ _ asof _ _) Nothing mRates return [ (x, Map.empty) | x <- cf ] -- asset cashflow with credit stress ---- By pool level -runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates +runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates = sequenceA $ parMap rdeepseq (\x -> Ast.projCashflow x asof assumps mRates) as ---- By index -runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = +runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = let numAssets = length as in @@ -1162,7 +1171,7 @@ runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.ByInde sequenceA $ parMap rdeepseq (\(x, a) -> Ast.projCashflow x asof a mRates) (zip as _assumps) ---- By Obligor -runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = +runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = let -- result cf,rules,assets -- matchAssets:: Ast.Asset c => [Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> [AP.ObligorStrategy] @@ -1238,8 +1247,6 @@ runPool (P.Pool as (CF.CashFlowFrame _ [],_) Nothing asof _ _) (Just (AP.ByOblig (cfs ++ (parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) astList)) [] [] - - in matchAssets [] obligorRules as diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 2fbd3ff4..635c95ff 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -624,7 +624,7 @@ performActionWrap d = let liqFunction = \(p@P.Pool{ P.issuanceStat = m} ) -> over (P.poolFutureScheduleCf . _Just . _1) (CF.extendCashFlow d) $ - over (P.poolFutureCf . _1 ) (CF.extendCashFlow d) $ + over (P.poolFutureCf . _Just . _1 ) (CF.extendCashFlow d) $ p { P.issuanceStat = Just (Map.insert RuntimeCurrentPoolBalance 0 (fromMaybe Map.empty m)) } poolMapToLiq = case (pt, mPid) of diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index 19a6479a..f804b40f 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -620,7 +620,7 @@ getAllCollectedFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map P getAllCollectedFrame t@TestDeal{pool = poolType} mPid = let mCf = case poolType of - MultiPool pm -> Map.map (view (P.poolFutureCf . _1 )) pm -- `debug` ("MultiPool" ++ show pm) + MultiPool pm -> Map.map (view (P.poolFutureCf . _Just . _1 )) pm -- `debug` ("MultiPool" ++ show pm) ResecDeal uds -> Map.map futureCf uds in case mPid of diff --git a/src/Pool.hs b/src/Pool.hs index 0b73be07..eb7c5cbd 100644 --- a/src/Pool.hs +++ b/src/Pool.hs @@ -41,11 +41,11 @@ import Util import Cashflow (CashFlowFrame) import qualified Stmt as CF import Debug.Trace -gebug = flip trace +debug = flip trace data Pool a = Pool {assets :: [a] -- ^ a list of assets in the pool - ,futureCf :: CF.PoolCashflow -- ^ collected cashflow from the assets in the pool + ,futureCf :: Maybe CF.PoolCashflow -- ^ collected cashflow from the assets in the pool ,futureScheduleCf :: Maybe CF.PoolCashflow -- ^ collected un-stressed cashflow ,asOfDate :: Date -- ^ include cashflow after this date ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) -- ^ cutoff balance of pool @@ -54,7 +54,7 @@ data Pool a = Pool {assets :: [a] -- ^ makeLensesFor [("futureCf","futureCfLens"),("futureScheduleCf","futureScheduleCfLens")] ''Pool -poolFutureCf :: Asset a => Lens' (Pool a) CF.PoolCashflow +poolFutureCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow) poolFutureCf = lens getter setter where getter p = futureCf p @@ -132,8 +132,8 @@ aggPool mStat xs calcLiquidationAmount :: Asset a => PricingMethod -> Pool a -> Date -> Amount calcLiquidationAmount (BalanceFactor currentFactor defaultFactor ) pool d = case futureCf pool of - (CF.CashFlowFrame _ [],_) -> 0 - _futureCf@(CF.CashFlowFrame _ trs,_) -> + Just (CF.CashFlowFrame _ [],_) -> 0 + Just _futureCf@(CF.CashFlowFrame _ trs,_) -> let earlierTxns = cutBy Inc Past d trs currentCumulativeDefaultBal = sum $ map (\x -> CF.mflowDefault x - CF.mflowRecovery x - CF.mflowLoss x) earlierTxns @@ -150,8 +150,8 @@ calcLiquidationAmount (BalanceFactor currentFactor defaultFactor ) pool d -- TODO: in revolving buy future schedule cashflow should be updated as well calcLiquidationAmount (PV discountRate recoveryPct) pool d = case futureCf pool of - (CF.CashFlowFrame _ [],_) -> 0 - (CF.CashFlowFrame _ trs,_) -> + Just (CF.CashFlowFrame _ [],_) -> 0 + Just (CF.CashFlowFrame _ trs,_) -> let futureTxns = cutBy Inc Future d trs -- `debug` (" pv date"++show d++ " with rate"++show discountRate) earlierTxns = cutBy Exc Past d trs -- `debug` ("Total txn"++show trs) @@ -164,7 +164,7 @@ calcLiquidationAmount (PV discountRate recoveryPct) pool d -- ^ price a pool with collected cashflow and future cashflow pricingPoolFlow :: Asset a => Date -> Pool a -> CF.PoolCashflow -> PricingMethod -> Amount -pricingPoolFlow d pool@Pool{ futureCf = (mCollectedCf,_), issuanceStat = mStat } (futureCfUncollected,_) pm +pricingPoolFlow d pool@Pool{ futureCf = Just (mCollectedCf,_), issuanceStat = mStat } (futureCfUncollected,_) pm = let currentCumulativeDefaultBal | CF.emptyCashFlowFrame mCollectedCf = 0 diff --git a/test/DealTest/DealTest.hs b/test/DealTest/DealTest.hs index da08b31b..dea9bc34 100644 --- a/test/DealTest/DealTest.hs +++ b/test/DealTest/DealTest.hs @@ -96,7 +96,7 @@ baseCase = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=(CF.CashFlowFrame dummySt [], Nothing) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance, 4000)] ,P.extendPeriods = Nothing}))]) diff --git a/test/DealTest/MultiPoolDealTest.hs b/test/DealTest/MultiPoolDealTest.hs index 61c5167d..cb0ae6da 100644 --- a/test/DealTest/MultiPoolDealTest.hs +++ b/test/DealTest/MultiPoolDealTest.hs @@ -38,7 +38,7 @@ dummySt = (0,Lib.toDate "19000101",Nothing) multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 1000 0.085 60 Nothing AB.Current] - ,P.futureCf= (CF.emptyCashflow,Nothing) + ,P.futureCf= Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,1000)] ,P.extendPeriods = Nothing @@ -46,7 +46,7 @@ multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage ,(PoolName "PoolB",(P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 3000 0.085 60 Nothing AB.Current] - ,P.futureCf=(CF.CashFlowFrame dummySt [],Nothing) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,3000)] ,P.extendPeriods = Nothing}))] diff --git a/test/DealTest/ResecDealTest.hs b/test/DealTest/ResecDealTest.hs index 5734a1f4..a3a8e604 100644 --- a/test/DealTest/ResecDealTest.hs +++ b/test/DealTest/ResecDealTest.hs @@ -78,7 +78,7 @@ baseCase = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=(CF.CashFlowFrame dummySt [],Nothing) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Nothing ,P.extendPeriods = Nothing}))]) diff --git a/test/DealTest/RevolvingTest.hs b/test/DealTest/RevolvingTest.hs index ced1ee07..52f859a0 100644 --- a/test/DealTest/RevolvingTest.hs +++ b/test/DealTest/RevolvingTest.hs @@ -36,7 +36,7 @@ import Control.Lens.TH multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 1000 0.085 60 Nothing AB.Current] - ,P.futureCf= (CF.emptyCashflow, Nothing) + ,P.futureCf= Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,1000)] ,P.extendPeriods = Nothing @@ -44,7 +44,7 @@ multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage ,(PoolName "PoolB",(P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 3000 0.085 60 Nothing AB.Current] - ,P.futureCf= (CF.emptyCashflow, Nothing) + ,P.futureCf= Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,3000)] ,P.extendPeriods = Nothing}))] diff --git a/test/UT/AccountTest.hs b/test/UT/AccountTest.hs index c4c56bc0..170744f6 100644 --- a/test/UT/AccountTest.hs +++ b/test/UT/AccountTest.hs @@ -87,7 +87,7 @@ reserveAccTest = ,CF.MortgageFlow (toDate "20220801") 110 20 10 0 0 0 0 0 Nothing Nothing Nothing ,CF.MortgageFlow (toDate "20220901") 90 20 10 0 0 0 0 0 Nothing Nothing Nothing ,CF.MortgageFlow (toDate "20221001") 70 20 10 0 0 0 0 0 Nothing Nothing Nothing] - ttd = set (dealPool . poolTypePool . (ix PoolConsol) . P.poolFutureCf) (testCFs, Nothing) td2 {accounts = accMap} + ttd = set (dealPool . poolTypePool . (ix PoolConsol) . P.poolFutureCf) (Just (testCFs, Nothing)) td2 {accounts = accMap} in testGroup "Test On Reserve Acc" [ diff --git a/test/UT/AssetTest.hs b/test/UT/AssetTest.hs index 3d8d6435..7c08f88b 100644 --- a/test/UT/AssetTest.hs +++ b/test/UT/AssetTest.hs @@ -626,7 +626,7 @@ delinqScheduleCFTest = ,CF.MortgageDelinqFlow (L.toDate "20231001") 500 500 0 0 0 0 0 0 0.08 Nothing Nothing Nothing ] pool = P.Pool ([]::[AB.Mortgage]) - ((CF.CashFlowFrame dummySt cfs), Nothing) + (Just (CF.CashFlowFrame dummySt cfs,Nothing)) Nothing (L.toDate "20230801") Nothing @@ -642,8 +642,8 @@ delinqScheduleCFTest = poolCf = fst . head $ case D.runPool pool assump1 Nothing of - Left _ -> undefined - Right x -> x + Left errorMsg -> undefined `debug` ("Error in pool run"++show errorMsg) + Right x -> x `debug` ("pool run resp"++show x) poolCf2 = fst . head $ case D.runPool pool assump2 Nothing of Left _ -> undefined diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs index eb2d7b26..9c08a64b 100644 --- a/test/UT/DealTest.hs +++ b/test/UT/DealTest.hs @@ -138,7 +138,7 @@ td2 = D.TestDeal { Nothing (AB.Defaulted Nothing) ] - ,P.futureCf=(CF.emptyCashflow, Nothing) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(RuntimeCurrentPoolBalance, 70)]} )] @@ -250,7 +250,7 @@ baseDeal = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf= (CF.emptyCashflow, Nothing) + ,P.futureCf= Nothing ,P.extendPeriods = Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(RuntimeCurrentPoolBalance, 70),(IssuanceBalance, 4000)]})] @@ -279,7 +279,7 @@ poolFlowTest = testCase "pool begin flow" $ assertEqual "pool size should be 60" (Just (Map.fromList [(PoolConsol ,60)])) - ( (\m -> Map.map CF.sizeCashFlowFrame m) <$> mPoolCf ) `debug` ("pool from test "++ show (mPoolCf)) + ( (\m -> Map.map CF.sizeCashFlowFrame m) <$> mPoolCf ) -- `debug` ("pool from test "++ show (mPoolCf)) ,testCase "total principal bal" $ assertEqual "pool bal should equal to total collect" diff --git a/test/UT/DealTest2.hs b/test/UT/DealTest2.hs index 84556033..58b1aa37 100644 --- a/test/UT/DealTest2.hs +++ b/test/UT/DealTest2.hs @@ -121,7 +121,7 @@ td = D.TestDeal { Nothing (AB.Defaulted Nothing) ] - ,P.futureCf=(CF.CashFlowFrame (0,epocDate,Nothing) [],Nothing) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Nothing} )] From c10b4a19bcae5c4dc4d3b4815333272d18e4938e Mon Sep 17 00:00:00 2001 From: yellowbean Date: Wed, 2 Jul 2025 22:36:53 +0800 Subject: [PATCH 22/49] WIP --- src/Deal.hs | 8 ++++---- src/Pool.hs | 4 ++-- swagger.json | 8 -------- 3 files changed, 6 insertions(+), 14 deletions(-) diff --git a/src/Deal.hs b/src/Deal.hs index f7e4edb4..58cd766d 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -1159,10 +1159,10 @@ runPool (P.Pool as _ _ asof _ _) Nothing mRates return [ (x, Map.empty) | x <- cf ] -- asset cashflow with credit stress ---- By pool level -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates +runPool (P.Pool as _ Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates = sequenceA $ parMap rdeepseq (\x -> Ast.projCashflow x asof assumps mRates) as ---- By index -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = +runPool (P.Pool as _ Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = let numAssets = length as in @@ -1171,7 +1171,7 @@ runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRa sequenceA $ parMap rdeepseq (\(x, a) -> Ast.projCashflow x asof a mRates) (zip as _assumps) ---- By Obligor -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = +runPool (P.Pool as _ Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = let -- result cf,rules,assets -- matchAssets:: Ast.Asset c => [Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> [AP.ObligorStrategy] @@ -1253,7 +1253,7 @@ runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) -- safe net to catch other cases -runPool _a _b _c = Left $ "Failed to match" ++ show _a ++ show _b ++ show _c +runPool _a _b _c = Left $ "[Run Pool]: Failed to match" ++ show _a ++ show _b ++ show _c -- ^ patch issuance balance for PreClosing Deal diff --git a/src/Pool.hs b/src/Pool.hs index eb7c5cbd..4d23edbe 100644 --- a/src/Pool.hs +++ b/src/Pool.hs @@ -57,13 +57,13 @@ makeLensesFor [("futureCf","futureCfLens"),("futureScheduleCf","futureScheduleCf poolFutureCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow) poolFutureCf = lens getter setter where - getter p = futureCf p + getter = futureCf setter p mNewCf = p {futureCf = mNewCf} poolFutureScheduleCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow) poolFutureScheduleCf = lens getter setter where - getter p = futureScheduleCf p + getter = futureScheduleCf setter p mNewCf = p {futureScheduleCf = mNewCf} poolIssuanceStat :: Asset a => Lens' (Pool a) (Map.Map CutoffFields Balance) diff --git a/swagger.json b/swagger.json index 8f5e3bba..3943a3f7 100644 --- a/swagger.json +++ b/swagger.json @@ -12910,7 +12910,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" @@ -12971,7 +12970,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" @@ -13032,7 +13030,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" @@ -13093,7 +13090,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" @@ -13154,7 +13150,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" @@ -13215,7 +13210,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" @@ -13276,7 +13270,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" @@ -13337,7 +13330,6 @@ }, "required": [ "assets", - "futureCf", "asOfDate" ], "type": "object" From f7c178b49d03060215415b474e6ba40b2d4abffc Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 3 Jul 2025 15:17:01 +0800 Subject: [PATCH 23/49] fix duplicate asset level cf in collection --- app/Main.hs | 4 +++- src/Deal.hs | 24 +++++++++++------------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index ca76d474..a2ecb28e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -34,6 +34,7 @@ import Data.List import Data.Map import qualified Data.Set as S import Data.Proxy +import Data.Time (getCurrentTime) import qualified Data.Text as T import Data.Maybe import Data.Yaml as Y @@ -473,9 +474,10 @@ main = do writeSwaggerJSON config <- BS.readFile "config.yml" + curTime <- getCurrentTime let mc = Y.decodeEither' config :: Either ParseException Config let (Config _p) = case mc of Left exp -> Config 8081 Right c -> c - print ("Engine start with version:"++ _version version1++";running at Port:"++ show _p) + print (show curTime ++ ">> Engine start with version:"++ _version version1++";running at Port:"++ show _p) run _p app diff --git a/src/Deal.hs b/src/Deal.hs index 58cd766d..175ba32d 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -1088,34 +1088,32 @@ appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap -- insert aggregated pool flow accUpdated = Map.adjust (\_v -> case (P.futureCf _v) of - Nothing -> set P.poolFutureCf (Just (CF.CashFlowFrame st txnCollected , mAssetFlow)) _v + Nothing -> set P.poolFutureCf (Just (CF.CashFlowFrame st txnCollected , Nothing)) _v Just _ -> over (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (++ txnToAppend) _v ) k acc - -- & ix k %~ over (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (++ txnToAppend) - -- & ix k %~ over (P.poolFutureCf . _Nothing) (\ () -> Just (CF.CashFlowFrame st txnCollected , mAssetFlow)) - -- insert breakdown asset flow accUpdated' = case mAssetFlow of Nothing -> accUpdated Just collectedAssetFlow -> let - appendFn Nothing = Just collectedAssetFlow + appendFn Nothing = Just collectedAssetFlow `debug` ("Hit Nothing for collectedAssetFlow at date:" ++ show d) appendFn (Just cfs) - | length cfs == length collectedAssetFlow = Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip cfs collectedAssetFlow ] - | length collectedAssetFlow > length cfs = - let - dummyCashFrames = replicate (length collectedAssetFlow - length cfs) CF.emptyCashflow - in - Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip (cfs++dummyCashFrames) collectedAssetFlow ] + | length cfs == length collectedAssetFlow + = Just $ [ origin & over CF.cashflowTxn (++ (view CF.cashflowTxn new)) | (origin,new) <- zip cfs collectedAssetFlow ] `debug` ("hit appending collectedAssetFlow at date:" ++ show d ++ " origin:" ++ show cfs ++ " new:" ++ show collectedAssetFlow) + | length collectedAssetFlow > length cfs + = let + dummyCashFrames = replicate (length collectedAssetFlow - length cfs) CF.emptyCashflow `debug` ("hit creating dummy cashflow for collectedAssetFlow at date:" ++ show d) + in + Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip (cfs++dummyCashFrames) collectedAssetFlow ] | otherwise = error "incomping cashflow number shall greater than existing cashflow number" in - accUpdated & ix k %~ (over (P.poolFutureCf . _Just . _2) appendFn) + accUpdated & ix k %~ (over (P.poolFutureCf . _Just . _2) appendFn) `debug` ("inserting breakdown flow"++ show collectedAssetFlow++ "at date:" ++ show d ++ "accUpdated:" ++ show accUpdated) in Map.adjust (over P.poolIssuanceStat (Map.insert RuntimeCurrentPoolBalance balInCollected)) - k accUpdated') + k accUpdated' `debug` ("after acc updated " ++ show accUpdated') ) poolM poolInflowMap ResecDeal uds -> From 696f5ab5827f8131774c65f95d6cf18fe221ec88 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 3 Jul 2025 15:49:55 +0800 Subject: [PATCH 24/49] expose UnUsedPoolFlow --- src/Deal.hs | 57 ++++++++++++++++++++++++-------------------- test/UT/DealTest.hs | 2 +- test/UT/DealTest2.hs | 3 +++ 3 files changed, 35 insertions(+), 27 deletions(-) diff --git a/src/Deal.hs b/src/Deal.hs index 175ba32d..7124306d 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -393,19 +393,22 @@ changeDealStatus (d,why) newSt t@TestDeal{status=oldSt} = (Just (DealStatusChang run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.PoolCashflow -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre]) - -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType))-> DL.DList ResultComponent -> Either String (TestDeal a,DL.DList ResultComponent) -run t@TestDeal{status=Ended} pCfM ads _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "By Status:Ended"))) -run t pCfM (Just []) _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "No Actions"))) -run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop: Stated Maturity"))) -run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop Run Flag"))) + -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType)) -> DL.DList ResultComponent + -> Either String (TestDeal a,DL.DList ResultComponent, Map.Map PoolId CF.PoolCashflow) +run t@TestDeal{status=Ended} pCfM ads _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "By Status:Ended")), pCfM) +run t pCfM (Just []) _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "No Actions")), pCfM) +run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop: Stated Maturity")), pCfM) +run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop Run Flag")), pCfM) run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=dStatus - ,waterfall=waterfallM,name=dealName,pool=pt,stats=_stat} + ,waterfall=waterfallM,name=dealName,pool=pt,stats=_stat} poolFlowMap (Just (ad:ads)) rates calls rAssump log | all (== 0) futureCashToCollect && (queryCompound t (getDate ad) AllAccBalance == Right 0) && (dStatus /= Revolving) && (dStatus /= Warehousing Nothing) --TODO need to use prsim here to cover all warehouse status = do let runContext = RunContext poolFlowMap rAssump rates --- `debug` ("ending at date " ++ show (getDate ad)) (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions - return (finalDeal, (DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving"))) -- `debug` ("End of pool collection with logs with length "++ show (length log)) + return (finalDeal + , (DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving")) + , poolFlowMap) | otherwise = case ad of @@ -472,7 +475,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= [DealStatusChangeTo d dStatus Called "Call by triggers before waterfall distribution", RunningWaterfall d W.CleanUp] (dealAfterCleanUp, rc_, newLogWaterfall_ ) <- foldM (performActionWrap d) (dRunWithTrigger0, rc1,log) cleanUpActions endingLogs <- Rpt.patchFinancialReports dealAfterCleanUp d newLogWaterfall_ - return (dealAfterCleanUp, DL.concat [logsBeforeDist,DL.fromList (newStLogs++[EndRun (Just d) "Clean Up"]),endingLogs]) -- `debug` ("Called ! "++ show d) + return (dealAfterCleanUp, DL.concat [logsBeforeDist,DL.fromList (newStLogs++[EndRun (Just d) "Clean Up"]),endingLogs], poolFlowMap) -- `debug` ("Called ! "++ show d) else do (dAfterWaterfall, rc2, newLogsWaterfall) <- foldM (performActionWrap d) (dRunWithTrigger0,rc1,log) waterfallToExe -- `debug` ("In RunWaterfall Date"++show d++">>> status "++show (status dRunWithTrigger0)++"before run waterfall collected >>"++ show (pool dRunWithTrigger0)) @@ -682,7 +685,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= (queryCompound t d (FutureCurrentPoolBegBalance Nothing)) (queryCompound t d (FutureCurrentSchedulePoolBegBalance Nothing)) let reduceCfs = Map.map (\f -> (over CF.cashflowTxn (\xs -> CF.scaleTsRow factor <$> xs) f, Nothing ) ) schedulePoolFlowMap -- need to apply with factor and trucate with date - (runDealWithSchedule,_) <- run t reduceCfs (Just ads) rates calls rAssump log + (runDealWithSchedule,_,_) <- run t reduceCfs (Just ads) rates calls rAssump log let bondWal = Map.map (L.calcWalBond d) (bonds runDealWithSchedule) -- `debug` ("Bond schedule flow"++ show (bonds runDealWithSchedule)) let bondSprd = Map.map (\x -> (spd + (fromMaybe 0 (lookupTable walTbl Up (fromRational x >))))) @@ -812,15 +815,15 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= do (dealAfterCleanUp, rc_, newLogWaterfall_ ) <- foldM (performActionWrap d) (t, runContext, log) cleanUpActions endingLogs <- Rpt.patchFinancialReports dealAfterCleanUp d newLogWaterfall_ - return (dealAfterCleanUp, DL.snoc (endingLogs `DL.append` newStLogs) (EndRun (Just d) "Clean Up")) -- `debug` ("Called ! "++ show d) + return (dealAfterCleanUp, DL.snoc (endingLogs `DL.append` newStLogs) (EndRun (Just d) "Clean Up"), poolFlowMap) -- `debug` ("Called ! "++ show d) _ -> run t poolFlowMap (Just ads) rates calls rAssump log StopRunTest d pres -> - do + do flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- pres ] case all id flags of - True -> Right (t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags)))) - _ -> run t poolFlowMap (Just ads) rates calls rAssump log + True -> Right (t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags))), poolFlowMap) + _ -> run t poolFlowMap (Just ads) rates calls rAssump log _ -> Left $ "Failed to match action on Date"++ show ad @@ -836,7 +839,7 @@ run t empty Nothing Nothing Nothing Nothing log (t, ads, pcf, unStressPcf) <- getInits S.empty 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 (t, log) -- `debug` ("End with pool CF is []") +run t empty _ _ _ _ log = Right (t, log ,empty) -- `debug` ("End with pool CF is []") @@ -1016,14 +1019,16 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts | otherwise = do (newT, ads, pcf, unStressPcf) <- getInits er t perfAssumps (Just nonPerfAssumps) - (_finalDeal, logs) <- run (removePoolCf newT) - pcf - (Just ads) - mInterest - (readCallOptions <$> opts) - mRevolvingCtx - DL.empty + (_finalDeal, logs, osPoolFlow) <- run (removePoolCf newT) + pcf + (Just ads) + mInterest + (readCallOptions <$> opts) + mRevolvingCtx + DL.empty + -- prepare deal with expected return let finalDeal = prepareDeal er _finalDeal + -- extract pool cash collected to deal let poolFlowUsedNoEmpty = Map.map (over CF.cashflowTxn CF.dropTailEmptyTxns) (getAllCollectedFrame finalDeal Nothing) @@ -1098,22 +1103,22 @@ appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap Nothing -> accUpdated Just collectedAssetFlow -> let - appendFn Nothing = Just collectedAssetFlow `debug` ("Hit Nothing for collectedAssetFlow at date:" ++ show d) + appendFn Nothing = Just collectedAssetFlow appendFn (Just cfs) | length cfs == length collectedAssetFlow - = Just $ [ origin & over CF.cashflowTxn (++ (view CF.cashflowTxn new)) | (origin,new) <- zip cfs collectedAssetFlow ] `debug` ("hit appending collectedAssetFlow at date:" ++ show d ++ " origin:" ++ show cfs ++ " new:" ++ show collectedAssetFlow) + = Just $ [ origin & over CF.cashflowTxn (++ (view CF.cashflowTxn new)) | (origin,new) <- zip cfs collectedAssetFlow ] | length collectedAssetFlow > length cfs = let - dummyCashFrames = replicate (length collectedAssetFlow - length cfs) CF.emptyCashflow `debug` ("hit creating dummy cashflow for collectedAssetFlow at date:" ++ show d) + dummyCashFrames = replicate (length collectedAssetFlow - length cfs) CF.emptyCashflow in Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip (cfs++dummyCashFrames) collectedAssetFlow ] | otherwise = error "incomping cashflow number shall greater than existing cashflow number" in - accUpdated & ix k %~ (over (P.poolFutureCf . _Just . _2) appendFn) `debug` ("inserting breakdown flow"++ show collectedAssetFlow++ "at date:" ++ show d ++ "accUpdated:" ++ show accUpdated) + accUpdated & ix k %~ (over (P.poolFutureCf . _Just . _2) appendFn) in Map.adjust (over P.poolIssuanceStat (Map.insert RuntimeCurrentPoolBalance balInCollected)) - k accUpdated' `debug` ("after acc updated " ++ show accUpdated') ) + k accUpdated') poolM poolInflowMap ResecDeal uds -> diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs index 9c08a64b..5f623ce1 100644 --- a/test/UT/DealTest.hs +++ b/test/UT/DealTest.hs @@ -327,7 +327,7 @@ triggerTests = testGroup "Trigger Tests" ,RunWaterfall (toDate "20220625") "" ,PoolCollection (toDate "20220701")"" ,RunWaterfall (toDate "20220725") "" ] - (fdeal,_) = case run td2 poolflowM (Just ads) Nothing Nothing Nothing DL.empty of + (fdeal,_,_) = case run td2 poolflowM (Just ads) Nothing Nothing Nothing DL.empty of Left _ -> error "" Right x -> x in diff --git a/test/UT/DealTest2.hs b/test/UT/DealTest2.hs index 58b1aa37..ed1debf7 100644 --- a/test/UT/DealTest2.hs +++ b/test/UT/DealTest2.hs @@ -151,6 +151,7 @@ bondGroups = Map.fromList [("A" ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F ,L.bndBalance=1500 ,L.bndRate=0.08 + ,L.bndStepUp = Nothing ,L.bndDuePrin=0.0 ,L.bndDueInt=0.0 ,L.bndDueIntOverInt=0.0 @@ -171,6 +172,7 @@ bondGroups = Map.fromList [("A" ,L.bndRate=0.08 ,L.bndDuePrin=0.0 ,L.bndDueInt=0.0 + ,L.bndStepUp = Nothing ,L.bndDueIntOverInt=0.0 ,L.bndDueIntDate=Nothing ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1) @@ -182,6 +184,7 @@ bondGroups = Map.fromList [("A" ,L.Bond{ L.bndName="B" ,L.bndType=L.Equity + ,L.bndStepUp = Nothing ,L.bndOriginInfo= L.OriginalInfo{ L.originBalance=3000 ,L.originDate= (T.fromGregorian 2022 1 1) From 287bad7e3d5f332596c89caff1d66d95933231de Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 3 Jul 2025 16:07:19 +0800 Subject: [PATCH 25/49] expose oustanding flow and fix UT --- src/Deal.hs | 14 +++++++++++--- test/DealTest/DealTest.hs | 2 +- test/DealTest/MultiPoolDealTest.hs | 2 +- test/DealTest/RevolvingTest.hs | 2 +- test/UT/DealTest.hs | 12 ++++++------ 5 files changed, 20 insertions(+), 12 deletions(-) diff --git a/src/Deal.hs b/src/Deal.hs index 7124306d..da7209e1 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -1013,7 +1013,11 @@ consoleDeal rs t = AssetLevelFlow -> t runDeal :: Ast.Asset a => TestDeal a -> S.Set ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption - -> Either String (TestDeal a, Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent], Map.Map String PriceResult) + -> Either String (TestDeal a + , Map.Map PoolId CF.CashFlowFrame + , [ResultComponent] + , Map.Map String PriceResult + , Map.Map PoolId CF.PoolCashflow) runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts ,AP.pricing = mPricing ,AP.revolving = mRevolving ,AP.interest = mInterest} | not runFlag = Left $ intercalate ";" $ show <$> valLogs | otherwise @@ -1035,7 +1039,11 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts bndPricing <- case mPricing of (Just p) -> priceBonds finalDeal p Nothing -> Right Map.empty - return (finalDeal, Just poolFlowUsedNoEmpty, Just (getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList logs), bndPricing) -- `debug` ("Run Deal end with") + return (finalDeal + , poolFlowUsedNoEmpty + , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList logs + , bndPricing + , osPoolFlow) where (runFlag, valLogs) = V.validateReq t nonPerfAssumps -- getinits() will get (new deal snapshot, actions, pool cashflows, unstressed pool cashflow) @@ -1346,7 +1354,7 @@ runPoolType flag (ResecDeal dm) mAssumps mNonPerfAssump Just (_poolAssump, _dealAssump) -> (Just _poolAssump, _dealAssump) in do - (dealRunned, _, _, _) <- runDeal uDeal (S.fromList []) poolAssump dealAssump + (dealRunned, _, _, _,_) <- runDeal uDeal (S.fromList []) poolAssump dealAssump let bondFlow = cutBy Inc Future sd $ concat $ Map.elems $ Map.map (DL.toList . Stmt.getTxns) $ getBondStmtByName dealRunned (Just [bn]) let bondFlowRated = (\(BondTxn d b i p r c di dioi f t) -> CF.BondFlow d b p i) <$> Stmt.scaleByFactor pct bondFlow return (CF.CashFlowFrame (0,sd,Nothing) bondFlowRated, Nothing)) diff --git a/test/DealTest/DealTest.hs b/test/DealTest/DealTest.hs index dea9bc34..7a7dfa0b 100644 --- a/test/DealTest/DealTest.hs +++ b/test/DealTest/DealTest.hs @@ -116,7 +116,7 @@ baseCase = D.TestDeal { baseTests = let nonRunAssump = (AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just [AP.InspectPt MonthEnd (FutureCurrentPoolBalance Nothing)]) Nothing Nothing Nothing Nothing Nothing Nothing) - (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of + (dealAfterRun,poolCf,rcs,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Left e -> error $ "Deal run failed"++ show e Right x -> x inspects = [ rc | rc@(InspectBal {}) <- rcs ] diff --git a/test/DealTest/MultiPoolDealTest.hs b/test/DealTest/MultiPoolDealTest.hs index cb0ae6da..eea547ad 100644 --- a/test/DealTest/MultiPoolDealTest.hs +++ b/test/DealTest/MultiPoolDealTest.hs @@ -107,7 +107,7 @@ mPoolbaseTests = ,FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])] ] nonRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just inspectVars) Nothing Nothing Nothing Nothing Nothing Nothing - (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of + (dealAfterRun,poolCf,rcs,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Right x -> x Left y -> error ("Error in running deal"++ show y) inspects = [ rc | rc@(InspectBal {}) <- rcs ] diff --git a/test/DealTest/RevolvingTest.hs b/test/DealTest/RevolvingTest.hs index 52f859a0..a46c9b13 100644 --- a/test/DealTest/RevolvingTest.hs +++ b/test/DealTest/RevolvingTest.hs @@ -118,7 +118,7 @@ baseTests = ,FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])] ] nonRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing rAssump Nothing (Just inspectVars) Nothing Nothing Nothing Nothing Nothing Nothing - (dealAfterRun,poolCf,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of + (dealAfterRun,poolCf,_,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Right x -> x Left y -> error ("Error in running deal"++ show y) in diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs index 5f623ce1..2d61e9da 100644 --- a/test/UT/DealTest.hs +++ b/test/UT/DealTest.hs @@ -269,22 +269,22 @@ baseDeal = D.TestDeal { poolFlowTest = let - (deal,mPoolCf,mResultComp,mPricing) = case (runDeal baseDeal S.empty Nothing emptyRunAssump) of + (deal,mPoolCf,mResultComp,mPricing,oustandingFlow) = case (runDeal baseDeal S.empty Nothing emptyRunAssump) of (Left er) -> error $ "Deal run failed"++ show er - (Right (a,b,c,d)) -> (a,b,c,d) + (Right (a,b,c,d,e)) -> (a,b,c,d,e) bndMap = D.viewBondsInMap deal in testGroup "pool cashflow test" [ testCase "pool begin flow" $ assertEqual "pool size should be 60" - (Just (Map.fromList [(PoolConsol ,60)])) - ( (\m -> Map.map CF.sizeCashFlowFrame m) <$> mPoolCf ) -- `debug` ("pool from test "++ show (mPoolCf)) + (Map.fromList [(PoolConsol ,60)]) + (Map.map CF.sizeCashFlowFrame mPoolCf ) -- `debug` ("pool from test "++ show (mPoolCf)) ,testCase "total principal bal" $ assertEqual "pool bal should equal to total collect" - (Just (Map.fromList [(PoolConsol ,4000)])) - ((\m -> Map.map CF.totalPrincipal m) <$> mPoolCf ) -- `debug` ("pool "++ show (viewBond)) + (Map.fromList [(PoolConsol ,4000)]) + (Map.map CF.totalPrincipal mPoolCf) -- `debug` ("pool "++ show (viewBond)) ,testCase "last bond A payment date" $ assertEqual "pool bal should equal to total collect" From 9d41a4300c67180b566effe78f46ba70bb7d485b Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 3 Jul 2025 17:52:04 +0800 Subject: [PATCH 26/49] expose unUsedPoolFlow --- app/Main.hs | 42 +++++++++++++++++++++--------------------- app/MainBase.hs | 2 +- src/Deal.hs | 18 ++++-------------- swagger.json | 35 +++++++++++++++++++++++++++-------- 4 files changed, 53 insertions(+), 44 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a2ecb28e..e06637a7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -108,36 +108,36 @@ version1 = Version "0.46.4" wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp wrapRun fs (MDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (MDeal _d,_pflow,_rs,_p) -- `debug` ("Run Done with deal->"++ show _d) + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (MDeal _d,_pflow,_rs,_p,_osPflow) wrapRun fs (RDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (RDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p,_osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (RDeal _d,_pflow,_rs,_p,_osPflow) wrapRun fs (IDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (IDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p,_osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (IDeal _d,_pflow,_rs,_p,_osPflow) wrapRun fs (LDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (LDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (LDeal _d,_pflow,_rs,_p,_osPflow) wrapRun fs (FDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (FDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (FDeal _d,_pflow,_rs,_p,_osPflow) wrapRun fs (UDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (UDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (UDeal _d,_pflow,_rs,_p,_osPflow) wrapRun fs (VDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (VDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (VDeal _d,_pflow,_rs,_p,_osPflow) wrapRun fs (PDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump - return (PDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (PDeal _d,_pflow,_rs,_p,_osPflow) wrapRun _ x _ _ = Left $ "RunDeal Failed ,due to unsupport deal type "++ show x @@ -345,25 +345,25 @@ doTweak r (SplitFixedBalance bn1 bn2) (dt , mAssump, rAssump, f) evalRootFindStop :: RootFindStop -> RunRespRight -> Double -evalRootFindStop (BondIncurLoss bn) (dt,_,_,_) +evalRootFindStop (BondIncurLoss bn) (dt,_,_,_,osPflow) = let bondBal = L.getOutstandingAmount $ getDealBondMap dt Map.! bn in (fromRational . toRational) $ bondBal - 0.01 -evalRootFindStop (BondIncurIntLoss bn threshold) (dt,_,_,_) +evalRootFindStop (BondIncurIntLoss bn threshold) (dt,_,_,_,osPflow) = let dueIntAmt = L.getTotalDueInt $ getDealBondMap dt Map.! bn in (fromRational . toRational) $ threshold - (dueIntAmt-0.01) -evalRootFindStop (BondIncurPrinLoss bn threshold) (dt,_,_,_) +evalRootFindStop (BondIncurPrinLoss bn threshold) (dt,_,_,_,osPflow) = let duePrinAmt = L.getCurBalance $ getDealBondMap dt Map.! bn in (fromRational . toRational) $ threshold - (duePrinAmt-0.01) -evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_,pResult) +evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_,pResult,osPflow) = let -- bnds otherBondsName = [] @@ -380,7 +380,7 @@ evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_, else (fromRational . toRational) $ bondBal - v -evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult) +evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult,osPflow) = let v = L.extractIrrResult $ pResult Map.! bn in diff --git a/app/MainBase.hs b/app/MainBase.hs index 83ee2ca0..bef659f8 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -144,7 +144,7 @@ data RunSimDealReq = OASReq DealType (Map.Map ScenarioName AP.ApplyAssumptionTyp deriving(Show, Generic) -type RunRespRight = (DealType , Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent],Map.Map String PriceResult) +type RunRespRight = (DealType , Map.Map PoolId CF.CashFlowFrame, [ResultComponent],Map.Map String PriceResult, Map.Map PoolId CF.PoolCashflow) type RunResp = Either String RunRespRight data RunPoolReq = SingleRunPoolReq Bool PoolTypeWrap (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) diff --git a/src/Deal.hs b/src/Deal.hs index da7209e1..4aed4613 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -417,8 +417,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= let cutOffPoolFlowMap = Map.map (\(pflow,mAssetFlow) -> (CF.splitCashFlowFrameByDate pflow d EqToLeft - ,(\xs -> [ CF.splitCashFlowFrameByDate x d EqToLeft | x <- xs ]) <$> mAssetFlow) - ) + ,(\xs -> [ CF.splitCashFlowFrameByDate x d EqToLeft | x <- xs ]) <$> mAssetFlow)) poolFlowMap collectedFlow = Map.map (\(p,mAstFlow) -> (fst p, (\xs -> [ fst x | x <- xs ]) <$> mAstFlow)) cutOffPoolFlowMap -- `debug` ("PoolCollection : "++ show d ++ " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap) -- outstandingFlow = Map.map (CF.insertBegTsRow d . snd) cutOffPoolFlowMap @@ -1000,17 +999,6 @@ readCallOptions opts = in (concat (fst <$> result), concat (snd <$> result)) -consoleDeal :: Ast.Asset a => (S.Set ExpectReturn) -> TestDeal a -> TestDeal a -consoleDeal rs t = - let - m = S.minView rs - in - case m of - Nothing -> t - Just (x, _rs) -> - case x of - DealLogs -> t - AssetLevelFlow -> t runDeal :: Ast.Asset a => TestDeal a -> S.Set ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption -> Either String (TestDeal a @@ -1043,7 +1031,9 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts , poolFlowUsedNoEmpty , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList logs , bndPricing - , osPoolFlow) + , osPoolFlow & mapped . _1 . CF.cashflowTxn %~ CF.dropTailEmptyTxns + & mapped . _2 . _Just . each . CF.cashflowTxn %~ CF.dropTailEmptyTxns + ) where (runFlag, valLogs) = V.validateReq t nonPerfAssumps -- getinits() will get (new deal snapshot, actions, pool cashflows, unstressed pool cashflow) diff --git a/swagger.json b/swagger.json index 3943a3f7..c083369f 100644 --- a/swagger.json +++ b/swagger.json @@ -9235,7 +9235,7 @@ } ] }, - "Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))": { + "Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))": { "oneOf": [ { "properties": { @@ -9273,10 +9273,29 @@ "$ref": "#/components/schemas/PriceResult" }, "type": "object" + }, + { + "additionalProperties": { + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "type": "object" } ], - "maxItems": 4, - "minItems": 4, + "maxItems": 5, + "minItems": 5, "type": "array" } }, @@ -21113,7 +21132,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } @@ -21202,7 +21221,7 @@ "content": { "application/json;charset=utf-8": { "schema": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" } } }, @@ -21231,7 +21250,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } @@ -21262,7 +21281,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } @@ -21293,7 +21312,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } From 6ed45e680dee1d05b5a2a9afd4ac343c67f5873d Mon Sep 17 00:00:00 2001 From: yellowbean Date: Fri, 4 Jul 2025 11:14:45 +0800 Subject: [PATCH 27/49] fix pool collection ending condition --- src/Cashflow.hs | 4 +++- src/Deal.hs | 5 +++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Cashflow.hs b/src/Cashflow.hs index 7dc6a674..ba175c41 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -28,7 +28,7 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,splitPoolCashflowByDate ,getAllDatesCashFlowFrame,splitCf, cutoffCashflow ,AssetCashflow,PoolCashflow - ,emptyCashflow + ,emptyCashflow,isEmptyRow2 ) where import Data.Time (Day) @@ -1119,6 +1119,7 @@ cutoffCashflow sd ds (CashFlowFrame st txns) extendTxns :: TsRow -> [Date] -> [TsRow] extendTxns tr ds = [ emptyTsRow d tr | d <- ds ] +-- test emtpy cashflow row isEmptyRow :: TsRow -> Bool isEmptyRow (MortgageDelinqFlow _ 0 0 0 0 0 0 0 0 _ _ _ _) = True isEmptyRow (MortgageFlow _ 0 0 0 0 0 0 0 _ _ _ _) = True @@ -1130,6 +1131,7 @@ isEmptyRow (CashFlow _ 0) = True isEmptyRow (ReceivableFlow _ 0 0 0 0 0 0 0 _ ) = True isEmptyRow _ = False +-- test emtpy cashflow row (ignore balance) isEmptyRow2 :: TsRow -> Bool isEmptyRow2 (MortgageDelinqFlow _ _ 0 0 0 0 0 0 0 _ _ _ _) = True isEmptyRow2 (MortgageFlow _ _ 0 0 0 0 0 0 _ _ _ _) = True diff --git a/src/Deal.hs b/src/Deal.hs index 4aed4613..8de75962 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -402,7 +402,7 @@ run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = Right (t, (DL.snoc log (EndRun run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=dStatus ,waterfall=waterfallM,name=dealName,pool=pt,stats=_stat} poolFlowMap (Just (ad:ads)) rates calls rAssump log - | all (== 0) futureCashToCollect && (queryCompound t (getDate ad) AllAccBalance == Right 0) && (dStatus /= Revolving) && (dStatus /= Warehousing Nothing) --TODO need to use prsim here to cover all warehouse status + | futureCashToCollectFlag && (queryCompound t (getDate ad) AllAccBalance == Right 0) && (dStatus /= Revolving) && (dStatus /= Warehousing Nothing) --TODO need to use prsim here to cover all warehouse status = do let runContext = RunContext poolFlowMap rAssump rates --- `debug` ("ending at date " ++ show (getDate ad)) (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions @@ -830,7 +830,8 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= where cleanUpActions = Map.findWithDefault [] W.CleanUp (waterfall t) -- `debug` ("Running AD"++show(ad)) remainCollectionNum = Map.elems $ Map.map (\(x,_) -> CF.sizeCashFlowFrame x ) poolFlowMap - futureCashToCollect = Map.elems $ Map.map (\(pcf,_) -> sum (CF.tsTotalCash <$> view CF.cashflowTxn pcf)) poolFlowMap + -- futureCashToCollectFlag = all (== 0) $ Map.elems $ Map.map (\(pcf,_) -> sum (CF.tsTotalCash <$> view CF.cashflowTxn pcf)) poolFlowMap + futureCashToCollectFlag = and $ Map.elems $ Map.map (\(pcf,_) -> all CF.isEmptyRow2 (view CF.cashflowTxn pcf)) poolFlowMap run t empty Nothing Nothing Nothing Nothing log From 30029147b50bbe37d05fe8c7931a8805d27df7ec Mon Sep 17 00:00:00 2001 From: yellowbean Date: Sat, 5 Jul 2025 02:03:36 +0800 Subject: [PATCH 28/49] expose stress factor range --- app/Main.hs | 15 +++++++++------ app/MainBase.hs | 10 ++++++---- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index e06637a7..e6dca22d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -323,24 +323,24 @@ getDealFeeMap (VDeal d) = DB.fees d getDealFeeMap (PDeal d) = DB.fees d doTweak :: Double -> RootFindTweak -> DealRunInput -> DealRunInput -doTweak r StressPoolDefault (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) +doTweak r (StressPoolDefault _) (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) = let stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressDefaultAssetPerf (toRational r)) assumps stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressDefaultAssetPerf (toRational r)) mRevolving } in (dt ,Just stressed, stressedNonPerf, f) -doTweak r StressPoolPrepayment (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) +doTweak r (StressPoolPrepayment _) (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) = let stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressPrepayAssetPerf (toRational r)) assumps stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressPrepayAssetPerf (toRational r)) mRevolving } in (dt ,Just stressed, stressedNonPerf, f) -doTweak r (MaxSpreadTo bn) (dt , mAssump, rAssump, f) +doTweak r (MaxSpreadTo bn _) (dt , mAssump, rAssump, f) = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump, f) -doTweak r (SplitFixedBalance bn1 bn2) (dt , mAssump, rAssump, f) +doTweak r (SplitFixedBalance bn1 bn2 _) (dt , mAssump, rAssump, f) = (modifyDealType (DM.SlideBalances bn1 bn2) r dt , mAssump, rAssump, f) @@ -405,8 +405,11 @@ runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssu itertimes = 500 def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.0001} riddersFn = case tweak of - SplitFixedBalance _ _ -> ridders def (0.99,0.01) - _ -> ridders def (500.0,0.00) -- default to 500.0,0.00 + SplitFixedBalance _ _ (l,h) -> ridders def (min h 0.99,max l 0.00001) + StressPoolDefault (l,h) -> ridders def (h ,max l 0.00) + StressPoolPrepayment (l,h) -> ridders def (h ,max l 0.00) + MaxSpreadTo _ (l,h) -> ridders def (h ,max l 0.00) + _ -> error ("Unsupported tweak for root finder" ++ show tweak) in case riddersFn (rootFindAlgo req tweak stop) of Root r -> Right $ RFResult r (doTweak r tweak req) diff --git a/app/MainBase.hs b/app/MainBase.hs index bef659f8..f81de992 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -168,10 +168,12 @@ data RootFindReq = FirstLossReq DealRunInput BondName | RootFinderReq DealRunInput RootFindTweak RootFindStop deriving(Show, Generic) -data RootFindTweak = StressPoolDefault -- stressed pool perf - | StressPoolPrepayment -- stressed pool prepayment - | MaxSpreadTo BondName -- bond component - | SplitFixedBalance BondName BondName -- bond component +type RangeInput = (Double, Double) -- (min, max) + +data RootFindTweak = StressPoolDefault RangeInput -- stressed pool perf + | StressPoolPrepayment RangeInput -- stressed pool prepayment + | MaxSpreadTo BondName RangeInput -- bond component + | SplitFixedBalance BondName BondName RangeInput -- bond component deriving(Show, Generic) data RootFindStop = BondIncurLoss BondName From 16e8dc2b831ae78ff6a8951f280a7f307e058263 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Sun, 6 Jul 2025 01:40:48 +0800 Subject: [PATCH 29/49] parameterise the tweaks --- app/Main.hs | 35 +++++++++++++-- app/MainBase.hs | 3 +- src/Deal.hs | 42 ++++++------------ swagger.json | 115 +++++++++++++++++++++++++++++++++++++++++++++--- 4 files changed, 155 insertions(+), 40 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index e6dca22d..64db21c7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -32,6 +32,7 @@ import Data.Attoparsec.ByteString import Data.ByteString (ByteString) import Data.List import Data.Map +import Data.Either (fromLeft) import qualified Data.Set as S import Data.Proxy import Data.Time (getCurrentTime) @@ -61,6 +62,7 @@ import Types import MainBase import qualified Deal as D import qualified Deal.DealBase as DB +import qualified Deal.DealDate as DD import qualified Deal.DealMod as DM import qualified Deal.DealQuery as Q import qualified Asset as Ast @@ -282,6 +284,17 @@ queryDealType (UDeal _d) = Q.queryCompound _d queryDealType (VDeal _d) = Q.queryCompound _d queryDealType (PDeal _d) = Q.queryCompound _d +queryClosingDate :: DealType -> Either String Date +queryClosingDate (MDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (RDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (IDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (LDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (FDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (UDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (VDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (PDeal _d) = DD.getClosingDate (DB.dates _d) + + queryDealTypeBool :: DealType -> Date -> DealStats -> Either String Bool queryDealTypeBool (MDeal _d) d s = Q.queryDealBool _d s d queryDealTypeBool (RDeal _d) d s = Q.queryDealBool _d s d @@ -388,6 +401,20 @@ evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult,osPflow) Nothing -> -1 -- `debug` ("No IRR found for bond:"++ show bn) Just irr -> (fromRational . toRational) $ irr - target -- `debug` ("IRR for bond:"++ show target ++" is "++ show irr) +evalRootFindStop (BalanceFormula ds targetBal) (dt,collectedFlow,logs,_,osPflow) + = let + _date = case find (\(EndRun d msg) -> True) (reverse logs) of + Just (EndRun (Just d) _ ) -> d + Nothing -> case queryClosingDate dt of + Right d' -> d' + Left err -> error $ "Error in BalanceFormula: " ++ err + v = case queryDealType dt _date (Q.patchDateToStats _date ds) of + Right v' -> fromRational v' + Left err -> error $ "Error in BalanceFormula: " ++ err + in + (fromRational . toRational) $ v - targetBal `debug` ("querydate" ++ show _date++"iteration" ++ show v ++ " target:" ++ show targetBal ++ ">> " ++ show ( v- targetBal)) + + rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double rootFindAlgo (dt ,poolAssumps, runAssumps, f) tweak stop r @@ -395,17 +422,17 @@ rootFindAlgo (dt ,poolAssumps, runAssumps, f) tweak stop r (dt' ,poolAssumps', runAssumps', f) = doTweak r tweak (dt ,poolAssumps, runAssumps, f) in case wrapRun f dt' poolAssumps' runAssumps' of - Right runRespRight -> evalRootFindStop stop runRespRight -- `debug` ("Begin pool"++ show poolAssumps') + Right runRespRight -> evalRootFindStop stop runRespRight `debug` ("RootFinder with f" ++ show r++ "with assumpt" ++ show poolAssumps') Left errorMsg -> -1 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving},f) tweak stop) = return $ let - itertimes = 500 - def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.0001} + itertimes = 1000 + def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.000001} riddersFn = case tweak of - SplitFixedBalance _ _ (l,h) -> ridders def (min h 0.99,max l 0.00001) + SplitFixedBalance _ _ (l,h) -> ridders def (min h 0.99, max l 0.00001) StressPoolDefault (l,h) -> ridders def (h ,max l 0.00) StressPoolPrepayment (l,h) -> ridders def (h ,max l 0.00) MaxSpreadTo _ (l,h) -> ridders def (h ,max l 0.00) diff --git a/app/MainBase.hs b/app/MainBase.hs index f81de992..639cf880 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -173,7 +173,7 @@ type RangeInput = (Double, Double) -- (min, max) data RootFindTweak = StressPoolDefault RangeInput -- stressed pool perf | StressPoolPrepayment RangeInput -- stressed pool prepayment | MaxSpreadTo BondName RangeInput -- bond component - | SplitFixedBalance BondName BondName RangeInput -- bond component + | SplitFixedBalance BondName BondName RangeInput -- bond component deriving(Show, Generic) data RootFindStop = BondIncurLoss BondName @@ -181,6 +181,7 @@ data RootFindStop = BondIncurLoss BondName | BondIncurIntLoss BondName Balance | BondPricingEqOriginBal BondName Bool Bool | BondMetTargetIrr BondName IRR + | BalanceFormula DealStats Balance deriving(Show, Generic) data RootFindResp = RFResult Double DealRunInput diff --git a/src/Deal.hs b/src/Deal.hs index 8de75962..38a15a2f 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -387,7 +387,7 @@ runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc, actions) d d changeDealStatus:: Ast.Asset a => (Date,String)-> DealStatus -> TestDeal a -> (Maybe ResultComponent, TestDeal a) -- ^ no status change for deal already ended -changeDealStatus _ _ t@TestDeal{status=Ended} = (Nothing, t) +changeDealStatus _ _ t@TestDeal{status=Ended _} = (Nothing, t) changeDealStatus (d,why) newSt t@TestDeal{status=oldSt} = (Just (DealStatusChangeTo d oldSt newSt why), t {status=newSt}) @@ -395,10 +395,10 @@ changeDealStatus (d,why) newSt t@TestDeal{status=oldSt} = (Just (DealStatusChang run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.PoolCashflow -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre]) -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType)) -> DL.DList ResultComponent -> Either String (TestDeal a,DL.DList ResultComponent, Map.Map PoolId CF.PoolCashflow) -run t@TestDeal{status=Ended} pCfM ads _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "By Status:Ended")), pCfM) -run t pCfM (Just []) _ _ _ log = Right (t,(DL.snoc log (EndRun Nothing "No Actions")), pCfM) -run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop: Stated Maturity")), pCfM) -run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = Right (t, (DL.snoc log (EndRun (Just d) "Stop Run Flag")), pCfM) +run t@TestDeal{status=(Ended endedDate)} pCfM ads _ _ _ log = return (t,DL.snoc log (EndRun (Just endedDate) "By Status:Ended"), pCfM) +run t pCfM (Just []) _ _ _ log = return (t,DL.snoc log (EndRun Nothing "No Actions"), pCfM) +run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = return (t, DL.snoc log (EndRun (Just d) "Stop: Stated Maturity"), pCfM) +run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = return (t, DL.snoc log (EndRun (Just d) "Stop Run Flag"), pCfM) run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=dStatus ,waterfall=waterfallM,name=dealName,pool=pt,stats=_stat} poolFlowMap (Just (ad:ads)) rates calls rAssump log @@ -407,7 +407,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= let runContext = RunContext poolFlowMap rAssump rates --- `debug` ("ending at date " ++ show (getDate ad)) (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions return (finalDeal - , (DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving")) + , DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving") , poolFlowMap) | otherwise @@ -446,9 +446,9 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= rates calls rAssump - (DL.concat [newLogs0,newLogs,eopActionsLog,newLogs1]) -- `debug` ("PoolCollection: Pt 05>> "++ show d++">> context flow>> "++show (runPoolFlow rc3)) + (DL.concat [newLogs0,newLogs,eopActionsLog,newLogs1]) 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) + run t poolFlowMap (Just ads) rates calls rAssump log RunWaterfall d "" -> let @@ -462,7 +462,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= callTest = fst $ fromMaybe ([]::[Pre],[]::[Pre]) calls 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)) + (dRunWithTrigger0, rc1, ads1, newLogs0) <- runTriggers (t, runContext, ads) d BeginDistributionWF let logsBeforeDist = DL.concat [newLogs0 , DL.fromList [ WarningMsg (" No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) | Map.notMember waterfallKey waterfallM ] ] flag <- anyM (testPre d dRunWithTrigger0) callTest -- `debug` ( "In RunWaterfall status after before waterfall trigger >>"++ show (status dRunWithTrigger0) ) @@ -515,7 +515,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= ("Failed to find fee "++feeName) (Map.lookup feeName feeMap) newF <- calcDueFee t d fToAcc - let newFeeMap = (Map.fromList [(feeName,newF)]) <> feeMap + let newFeeMap = Map.fromList [(feeName,newF)] <> feeMap run (t{fees=newFeeMap}) poolFlowMap (Just ads) rates calls rAssump log ResetLiqProvider d liqName -> @@ -704,7 +704,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= L.payYield d intToPay bnd1) (bonds t) bondPricingResult - run t {bonds = depositBondFlow, status = Ended } Map.empty (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call") + run t {bonds = depositBondFlow, status = Ended d} Map.empty (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call") FundBond d Nothing bName accName fundAmt -> let @@ -821,7 +821,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= do flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- pres ] case all id flags of - True -> Right (t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags))), poolFlowMap) + True -> return (t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags))), poolFlowMap) _ -> run t poolFlowMap (Just ads) rates calls rAssump log @@ -830,7 +830,6 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= where cleanUpActions = Map.findWithDefault [] W.CleanUp (waterfall t) -- `debug` ("Running AD"++show(ad)) remainCollectionNum = Map.elems $ Map.map (\(x,_) -> CF.sizeCashFlowFrame x ) poolFlowMap - -- futureCashToCollectFlag = all (== 0) $ Map.elems $ Map.map (\(pcf,_) -> sum (CF.tsTotalCash <$> view CF.cashflowTxn pcf)) poolFlowMap futureCashToCollectFlag = and $ Map.elems $ Map.map (\(pcf,_) -> all CF.isEmptyRow2 (view CF.cashflowTxn pcf)) poolFlowMap @@ -1034,7 +1033,7 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts , bndPricing , osPoolFlow & mapped . _1 . CF.cashflowTxn %~ CF.dropTailEmptyTxns & mapped . _2 . _Just . each . CF.cashflowTxn %~ CF.dropTailEmptyTxns - ) + ) -- `debug` ("run deal done with pool" ++ show poolFlowUsedNoEmpty) where (runFlag, valLogs) = V.validateReq t nonPerfAssumps -- getinits() will get (new deal snapshot, actions, pool cashflows, unstressed pool cashflow) @@ -1502,21 +1501,6 @@ getInits er t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats -> foldr (\(feeName,feeFlow) accM -> Map.adjust (\v -> v {F.feeType = F.FeeFlow feeFlow}) feeName accM) feeMap pairs pCfM <- runPoolType True thePool mAssumps mNonPerfAssump pScheduleCfM <- runPoolType True thePool Nothing mNonPerfAssump - -- Cutoff cashflow by start date - -- let poolCfTsM = Map.map (\((poolCf, pstats), mAssetFlow) - -- -> (over CF.cashflowTxn (cutBy Inc Future startDate) poolCf - -- ,(map (over CF.cashflowTxn (cutBy Inc Future startDate))) <$> mAssetFlow) - -- ) - -- pCfM - -- let poolCfTsMwithBegRow = Map.map (\case - -- (x:xs) -> buildBegTsRow startDate x:x:xs - -- [] -> []) - -- poolCfTsM - -- let poolAggCfM = Map.map (\x -> CF.aggTsByDates x (getDates pActionDates)) poolCfTsMwithBegRow - -- let pCollectionCfAfterCutoff = Map.map (\case - -- [] -> CF.CashFlowFrame (0,startDate,Nothing) [] - -- (txn:txns) -> CF.CashFlowFrame (CF.mflowBegBalance txn,startDate,Nothing) (txn:txns) ) - -- poolAggCfM -- `debug` ("Pool agg cfm"++ show (Map.map (sliceBy II (toDate "20241201") (toDate "20241231") ) poolAggCfM)) let aggDates = getDates pActionDates let pCollectionCfAfterCutoff = Map.map (\(pCf, mAssetFlow) -> diff --git a/swagger.json b/swagger.json index c083369f..7a013f4f 100644 --- a/swagger.json +++ b/swagger.json @@ -9016,6 +9016,9 @@ }, { "properties": { + "contents": { + "$ref": "#/components/schemas/Day" + }, "tag": { "enum": [ "Ended" @@ -9024,7 +9027,8 @@ } }, "required": [ - "tag" + "tag", + "contents" ], "title": "Ended", "type": "object" @@ -16649,6 +16653,36 @@ ], "title": "BondMetTargetIrr", "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/DealStats" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BalanceFormula" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BalanceFormula", + "type": "object" } ] }, @@ -16656,6 +16690,21 @@ "oneOf": [ { "properties": { + "contents": { + "items": [ + { + "format": "double", + "type": "number" + }, + { + "format": "double", + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, "tag": { "enum": [ "StressPoolDefault" @@ -16664,13 +16713,29 @@ } }, "required": [ - "tag" + "tag", + "contents" ], "title": "StressPoolDefault", "type": "object" }, { "properties": { + "contents": { + "items": [ + { + "format": "double", + "type": "number" + }, + { + "format": "double", + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, "tag": { "enum": [ "StressPoolPrepayment" @@ -16679,7 +16744,8 @@ } }, "required": [ - "tag" + "tag", + "contents" ], "title": "StressPoolPrepayment", "type": "object" @@ -16687,7 +16753,29 @@ { "properties": { "contents": { - "type": "string" + "items": [ + { + "type": "string" + }, + { + "items": [ + { + "format": "double", + "type": "number" + }, + { + "format": "double", + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "tag": { "enum": [ @@ -16712,10 +16800,25 @@ }, { "type": "string" + }, + { + "items": [ + { + "format": "double", + "type": "number" + }, + { + "format": "double", + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" } ], - "maxItems": 2, - "minItems": 2, + "maxItems": 3, + "minItems": 3, "type": "array" }, "tag": { From 0b242253dd44c239520d59a1d4ee670157061eb6 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Sun, 6 Jul 2025 01:50:04 +0800 Subject: [PATCH 30/49] fix UT --- src/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Types.hs b/src/Types.hs index d4868a32..b7c6613b 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -487,7 +487,7 @@ data DealStatus = DealAccelerated (Maybe Date) -- ^ Deal is accelerated sta | PreClosing DealStatus -- ^ Deal is not closed, but has a closing date | Warehousing (Maybe DealStatus) -- ^ Deal is not closed, but closing date is not determined yet | Called -- ^ Deal is called - | Ended -- ^ Deal is marked as closed + | Ended Date -- ^ Deal is marked as closed deriving (Show,Ord,Eq,Read, Generic) -- ^ pricing methods for assets From fc938aa6a587c6fbc7634cdeaa1cdf626269bc5b Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 7 Jul 2025 01:04:54 +0800 Subject: [PATCH 31/49] remove debug --- app/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 64db21c7..d9669dd9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -412,7 +412,7 @@ evalRootFindStop (BalanceFormula ds targetBal) (dt,collectedFlow,logs,_,osPflow) Right v' -> fromRational v' Left err -> error $ "Error in BalanceFormula: " ++ err in - (fromRational . toRational) $ v - targetBal `debug` ("querydate" ++ show _date++"iteration" ++ show v ++ " target:" ++ show targetBal ++ ">> " ++ show ( v- targetBal)) + (fromRational . toRational) $ v - targetBal -- `debug` ("querydate" ++ show _date++"iteration" ++ show v ++ " target:" ++ show targetBal ++ ">> " ++ show ( v- targetBal)) @@ -422,7 +422,7 @@ rootFindAlgo (dt ,poolAssumps, runAssumps, f) tweak stop r (dt' ,poolAssumps', runAssumps', f) = doTweak r tweak (dt ,poolAssumps, runAssumps, f) in case wrapRun f dt' poolAssumps' runAssumps' of - Right runRespRight -> evalRootFindStop stop runRespRight `debug` ("RootFinder with f" ++ show r++ "with assumpt" ++ show poolAssumps') + Right runRespRight -> evalRootFindStop stop runRespRight -- `debug` ("RootFinder with f" ++ show r++ "with assumpt" ++ show poolAssumps') Left errorMsg -> -1 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) From e5c8dccdc6ebbde4912929d25e17278c779fa1e0 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Tue, 8 Jul 2025 17:50:59 +0800 Subject: [PATCH 32/49] add build.nix --- Hastructure.cabal | 1 - README.md | 4 ---- build.nix | 10 ++++++++++ 3 files changed, 10 insertions(+), 5 deletions(-) create mode 100644 build.nix diff --git a/Hastructure.cabal b/Hastructure.cabal index 7dca04da..9e8b4252 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -158,7 +158,6 @@ executable Hastructure-exe , regex-tdfa , scientific , servant - , servant-checked-exceptions , servant-openapi3 , servant-server , split diff --git a/README.md b/README.md index 33004a32..5c24f855 100644 --- a/README.md +++ b/README.md @@ -82,10 +82,6 @@ * Misc * Support user define pay dates & pool collection dates -### Premium Support - - slack -> https://absboxhastructure.slack.com - ### Online Demo diff --git a/build.nix b/build.nix new file mode 100644 index 00000000..73fe7c97 --- /dev/null +++ b/build.nix @@ -0,0 +1,10 @@ +{ nixpkgs ? import (fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/refs/tags/25.05.tar.gz"; + sha256 = "1915r28xc4znrh2vf4rrjnxldw2imysz819gzhk9qlrkqanmfsxd"; # Replace with actual hash + }) {} +}: +let + # Use the Haskell package set from nixpkgs + haskellPackages = nixpkgs.haskellPackages; +in + haskellPackages.callCabal2nix "Hastructure" ./. {} From 97cecfa60c50769720769e429e94d06eb4e3cd9e Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 00:29:21 +0800 Subject: [PATCH 33/49] add pool outstanding warning message --- Hastructure.cabal | 12 +++++++---- src/Deal.hs | 48 ++++++++++++++++++++---------------------- src/Deal/DealAction.hs | 2 -- src/Deal/DealQuery.hs | 15 ++++++------- src/Waterfall.hs | 2 +- 5 files changed, 39 insertions(+), 40 deletions(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index 9e8b4252..9fc4de0a 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -25,8 +25,6 @@ source-repository head type: git location: https://github.com/yellowbean/Hastructure -with-compiler: ghc-9.8.2 - library exposed-modules: Accounts @@ -72,6 +70,8 @@ library Waterfall other-modules: Paths_Hastructure + autogen-modules: + Paths_Hastructure hs-source-dirs: src build-depends: @@ -86,7 +86,7 @@ library , aeson , attoparsec-aeson , aeson-pretty - , base + , base >= 4.5 && < 4.20 , bytestring , containers , deepseq @@ -126,6 +126,8 @@ executable Hastructure-exe other-modules: MainBase Paths_Hastructure + autogen-modules: + Paths_Hastructure hs-source-dirs: app ghc-options: -threaded -rtsopts -with-rtsopts=-N @@ -167,7 +169,7 @@ executable Hastructure-exe , template-haskell , text , time - , unordered-containers + , unordered-containers >= 0.2 && < 0.2.20 , wai , wai-cors , warp @@ -179,6 +181,8 @@ executable Hastructure-exe test-suite Hastructure-test type: exitcode-stdio-1.0 main-is: MainTest.hs + autogen-modules: + Paths_Hastructure other-modules: DealTest.DealTest DealTest.MultiPoolDealTest diff --git a/src/Deal.hs b/src/Deal.hs index 38a15a2f..47bcdf2a 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleContexts #-} module Deal (run,runPool,getInits,runDeal,ExpectReturn(..) ,performAction @@ -125,7 +126,6 @@ setBondNewRate t d ras b@(L.MultiIntBond bn _ _ iis _ bal currentRates _ dueInts 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 @@ -166,7 +166,6 @@ accrueSrt t d srt@HE.SRT{ HE.srtDuePremium = duePrem, HE.srtRefBalance = bal, HE = do newBal <- case st of HE.SrtByEndDay ds dp -> queryCompound t d (patchDateToStats d ds) - _ -> Left "not support new bal type for Srt" let newPremium = duePrem + calcInt (fromRational newBal) (fromMaybe sd mDueDate) d rate DC_ACT_365F let accrueInt = calcInt (HE.srtRefBalance srt + duePrem) (fromMaybe d (HE.srtDuePremiumDate srt)) d (HE.srtPremiumRate srt) DC_ACT_365F return srt { HE.srtRefBalance = fromRational newBal, HE.srtDuePremium = newPremium, HE.srtDuePremiumDate = Just d} @@ -182,7 +181,6 @@ updateLiqProviderRate t d ras liq@CE.LiqFacility{CE.liqRateType = mRt, CE.liqPre in liq {CE.liqRate = newMr, CE.liqPremiumRate = newMpr } -updateLiqProviderRate t d ras liq = liq evalFloaterRate :: Date -> [RateAssumption] -> IR.RateType -> IRate evalFloaterRate _ _ (IR.Fix _ r) = r @@ -302,8 +300,8 @@ accrueRC t d rs rc@RateCap{rcNetCash = amt, rcStrikeRate = strike,rcIndex = inde testCall :: Ast.Asset a => TestDeal a -> Date -> C.CallOption -> Either String Bool testCall t d opt = case opt of - C.PoolBalance x -> (< x) <$> fromRational <$> queryCompound t d (FutureCurrentPoolBalance Nothing) - C.BondBalance x -> (< x) <$> fromRational <$> queryCompound t d CurrentBondBalance + C.PoolBalance x -> (< x) . fromRational <$> queryCompound t d (FutureCurrentPoolBalance Nothing) + C.BondBalance x -> (< x) . fromRational <$> queryCompound t d CurrentBondBalance C.PoolFactor x -> (< x) <$> queryCompound t d (FutureCurrentPoolFactor d Nothing) -- `debug` ("D "++show d++ "Pool Factor query ->" ++ show (queryDealRate t (FutureCurrentPoolFactor d))) C.BondFactor x -> (< x) <$> queryCompound t d BondFactor C.OnDate x -> Right $ x == d @@ -408,7 +406,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions return (finalDeal , DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving") - , poolFlowMap) + , poolFlowMap) | otherwise = case ad of @@ -416,9 +414,9 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= if any (> 0) remainCollectionNum then let cutOffPoolFlowMap = Map.map (\(pflow,mAssetFlow) -> - (CF.splitCashFlowFrameByDate pflow d EqToLeft - ,(\xs -> [ CF.splitCashFlowFrameByDate x d EqToLeft | x <- xs ]) <$> mAssetFlow)) - poolFlowMap + (CF.splitCashFlowFrameByDate pflow d EqToLeft + ,(\xs -> [ CF.splitCashFlowFrameByDate x d EqToLeft | x <- xs ]) <$> mAssetFlow)) + poolFlowMap collectedFlow = Map.map (\(p,mAstFlow) -> (fst p, (\xs -> [ fst x | x <- xs ]) <$> mAstFlow)) cutOffPoolFlowMap -- `debug` ("PoolCollection : "++ show d ++ " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap) -- outstandingFlow = Map.map (CF.insertBegTsRow d . snd) cutOffPoolFlowMap outstandingFlow = Map.map (\(p,mAstFlow) -> (snd p, (\xs -> [ snd x | x <- xs ]) <$> mAstFlow)) cutOffPoolFlowMap @@ -789,8 +787,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= -- 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 + let newBndMap = Map.insert bName (newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d ,L.bndLastIntPay = Just d}) bndMap let newAds = sortBy sortActionOnDate $ filteredAds ++ bResetActions run t{bonds = newBndMap, accounts = newAccMap} poolFlowMap (Just newAds) rates calls rAssump log @@ -931,7 +928,7 @@ priceBondIrr (AP.BuyBond dateToBuy bPricingMethod (AP.ByCash cash) Nothing) txns (ds2, vs2) = (getDate <$> futureFlow', getTxnAmt <$> boughtTxns) in do - irr <- Analytics.calcIRR ([ds1]++ds2) ([vs1]++vs2) + irr <- Analytics.calcIRR (ds1:ds2) (vs1:vs2) return (irr, (BondTxn dateToBuy 0 (negate accuredInt) (negate buyPaidOut) 0 vs1 0 0 Nothing Types.Empty):boughtTxns) where -- assume cashflow of buy date belongs to seller(owner) @@ -945,7 +942,7 @@ priceBonds t (AP.DiscountCurve d dc) = Right $ Map.map (L.priceBond d dc) (viewB priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bondPrices) = sequenceA $ Map.mapWithKey - (\bn (pd,price)-> ZSpread <$> (L.calcZspread (price,pd) (bndMap Map.! bn) curve)) + (\bn (pd,price)-> ZSpread <$> L.calcZspread (price,pd) (bndMap Map.! bn) curve) bondPrices -- Calc Irr of bonds priceBonds t@TestDeal {bonds = bndMap} (AP.IrrInput bMapInput) @@ -987,7 +984,6 @@ splitCallOpts (AP.LegacyOpts copts) = ([ cFn copt | copt <- copts ],[]) -- legacyCallOptConvert (AP.CallOptions opts) = concat [ legacyCallOptConvert o | o <- opts ] splitCallOpts (AP.CallOnDates dp ps) = ([],ps) -splitCallOpts x = error $ "Failed to find call option types but got"++ show x -- , @@ -1029,7 +1025,7 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts Nothing -> Right Map.empty return (finalDeal , poolFlowUsedNoEmpty - , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList logs + , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList (DL.append logs (unCollectedPoolFlowWarning osPoolFlow)) , bndPricing , osPoolFlow & mapped . _1 . CF.cashflowTxn %~ CF.dropTailEmptyTxns & mapped . _2 . _Just . each . CF.cashflowTxn %~ CF.dropTailEmptyTxns @@ -1042,7 +1038,12 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts Nothing -> Nothing Just (AP.AvailableAssets rp rperf) -> Just (Map.fromList [("Consol", (rp, rperf))]) Just (AP.AvailableAssetsBy rMap) -> Just rMap - Just _ -> error ("Failed to match revolving assumption"++show mRevolving) + -- TODO: need to add warning if uncollected pool flow is not empty + unCollectedPoolFlowWarning pMap = if sum (Map.elems (Map.map (CF.sizeCashFlowFrame . view _1) pMap)) > 0 then + DL.singleton $ WarningMsg "Oustanding pool cashflow hasn't been collected yet" + else + DL.empty + -- run() is a recusive function loop over all actions till deal end conditions are met -- | get bond principal and interest shortfalls from a deal @@ -1136,7 +1137,6 @@ removePoolCf t@TestDeal{pool=pt} = newPt = case pt of MultiPool pm -> MultiPool $ set (mapped . P.poolFutureCf) Nothing pm ResecDeal uds -> ResecDeal uds - _ -> error $ "not implement:" ++ show pt in t {pool = newPt} @@ -1147,7 +1147,7 @@ runPool :: Ast.Asset a => P.Pool a -> Maybe AP.ApplyAssumptionType -> Maybe [Rat -- schedule cashflow just ignores the interest rate assumption 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 +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") -- project contractual cashflow if nothing found in pool perf assumption @@ -1168,7 +1168,7 @@ runPool (P.Pool as _ Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = numAssets = length as in do - _assumps <- sequenceA $ map (AP.lookupAssumptionByIdx idxAssumps) [0..(pred numAssets)] -- `debug` ("Num assets"++ show numAssets) + _assumps <- traverse (AP.lookupAssumptionByIdx idxAssumps) [0..(pred numAssets)] -- `debug` ("Num assets"++ show numAssets) sequenceA $ parMap rdeepseq (\(x, a) -> Ast.projCashflow x asof a mRates) (zip as _assumps) ---- By Obligor @@ -1384,16 +1384,16 @@ getInits er t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats [ ResetLiqProviderRate _d _liqName |(_liqName,__liqResetDates) <- _liqRateResetDates , _d <- __liqResetDates ] --inspect dates let inspectDates = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.inspectOn = Just inspectList } -> concat $ (expandInspect startDate endDate) <$> inspectList + Just AP.NonPerfAssumption{AP.inspectOn = Just inspectList } -> concatMap (expandInspect startDate endDate) inspectList _ -> [] let financialRptDates = case mNonPerfAssump of Just AP.NonPerfAssumption{AP.buildFinancialReport= Just dp } -> let - _ds = genSerialDatesTill2 II startDate dp endDate + (s:_ds) = genSerialDatesTill2 II startDate dp endDate in - [ BuildReport _sd _ed | (_sd,_ed) <- zip _ds (tail _ds) ] -- `debug` ("ds"++ show _ds) - _ -> [] -- `debug` ("emtpy rpt dates") + [ BuildReport _sd _ed | (_sd,_ed) <- zip (s:_ds) _ds ] -- `debug` ("ds"++ show _ds) + _ -> [] let irUpdateSwapDates = case rateSwap t of Nothing -> [] @@ -1594,8 +1594,6 @@ depositInflow d (W.CollectByPct mPids s splitRules) pFlowMap amap --TODO need where txns = extractTxnsFromFlowFrameMap mPids pFlowMap -depositInflow _ a _ _ = Left $ " Failed to match collection rule "++ show a - -- ^ deposit cash to account by pool map CF and rules depositPoolFlow :: [W.CollectionRule] -> Date -> Map.Map PoolId CF.PoolCashflow -> Map.Map String A.Account -> Either String (Map.Map String A.Account) depositPoolFlow rules d pFlowMap amap diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 635c95ff..baeb8dc7 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -280,7 +280,6 @@ calcDueInt t d b@(L.Bond bn bt bo (L.WithIoI intInfo ioiIntInfo) _ bond_bal bond 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 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 } @@ -297,7 +296,6 @@ calcDueInt t d b@(L.MultiIntBond {}) calcDueInt t d b@(L.Bond {}) = Right $ L.accrueInt d b -- `debug` ("Hit to defualt accru"++ show (L.bndName b)) -calcDueInt t d b = error $ "Not implemented for calcDueInt for bond type" ++ show b -- ^ modify due principal for bond calcDuePrin :: Ast.Asset a => TestDeal a -> Date -> L.Bond -> Either String L.Bond diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index 315716dc..b527f62c 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -274,17 +274,16 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f --TODO need to use projected current balance instead of current balance PoolWaSpread mPns -> let - assets = getAllAsset t mPns - bals = P.getCurrentBal <$> concat (Map.elems assets) - spreads = map - (\x -> - case x of - AB.MortgageOriginalInfo { AB.originRate = r } -> fromMaybe 0.0 $ IR._getSpread r + assets = getAllAsset t mPns + bals = P.getCurrentBal <$> concat (Map.elems assets) + spreads = map + (\case + AB.MortgageOriginalInfo { AB.originRate = r } -> fromMaybe 0.0 $ IR._getSpread r AB.LoanOriginalInfo { AB.originRate = r } -> fromMaybe 0.0 $ IR._getSpread r _ -> 0.0) - (P.getOriginInfo <$> concat (Map.elems assets)) + (P.getOriginInfo <$> concat (Map.elems assets)) in - Right $ weightedBy (toRational <$> bals) (toRational <$> spreads) + Right $ weightedBy (toRational <$> bals) (toRational <$> spreads) DealStatRate s -> case stats t of diff --git a/src/Waterfall.hs b/src/Waterfall.hs index 5d3eeeb8..555c190b 100644 --- a/src/Waterfall.hs +++ b/src/Waterfall.hs @@ -135,4 +135,4 @@ $(deriveJSON defaultOptions ''BookType) $(deriveJSON defaultOptions ''ExtraSupport) $(deriveJSON defaultOptions ''PayOrderBy) $(deriveJSON defaultOptions ''Action) -$(deriveJSON defaultOptions ''CollectionRule) \ No newline at end of file +$(deriveJSON defaultOptions ''CollectionRule) From c5c9a79746bde05732c6c434f26c08a5d9a781e3 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 01:14:47 +0800 Subject: [PATCH 34/49] finalized cabal file --- Hastructure.cabal | 262 +++++++++++++++++++++++----------------------- 1 file changed, 133 insertions(+), 129 deletions(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index 9fc4de0a..fc4f4dfa 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -19,8 +19,8 @@ license-file: LICENSE build-type: Simple extra-source-files: README.md +extra-doc-files: CHANGELOG.md - source-repository head type: git location: https://github.com/yellowbean/Hastructure @@ -75,50 +75,51 @@ library hs-source-dirs: src build-depends: - Decimal - , base-compat - , attoparsec - , string-conversions - , warp - , wai-cors - , http-types - , exceptions - , aeson - , attoparsec-aeson - , aeson-pretty - , base >= 4.5 && < 4.20 - , bytestring - , containers - , deepseq - , generic-lens - , hashable - , ieee754 - , lens - , math-functions - , monad-loops - , mtl - , numeric-limits - , openapi3 - , parallel - , regex-base - , regex-pcre-builtin - , regex-tdfa - , scientific - , servant - , servant-openapi3 - , servant-server - , split - , swagger2 - , tabular - , template-haskell - , text - , time - , wai - , yaml - , vector - , MissingH - , dlist --- , proto3-wire + Decimal >= 0.5.2 && < 0.6, + base >= 4.19.2 && < 4.20, + deepseq >= 1.5.1 && < 1.6, + MissingH >= 1.6.0 && < 1.7, + containers >= 0.6.8 && < 0.7, + template-haskell >= 2.21.0 && < 2.22, + bytestring >= 0.12.1 && < 0.13, + exceptions >= 0.10.7 && < 0.11, + mtl >= 2.3.1 && < 2.4, + time >= 1.12.2 && < 1.13, + text >= 2.1.1 && < 2.2, + regex-base >= 0.94.0 && < 0.95, + aeson >= 2.2.3 && < 2.3, + hashable >= 1.4.7 && < 1.5, + dlist >= 1.0 && < 1.1, + scientific >= 0.3.8 && < 0.4, + vector >= 0.13.2 && < 0.14, + aeson-pretty >= 0.8.10 && < 0.9, + base-compat >= 0.14.1 && < 0.15, + attoparsec >= 0.14.4 && < 0.15, + attoparsec-aeson >= 2.2.2 && < 2.3, + generic-lens >= 2.2.2 && < 2.3, + http-types >= 0.12.4 && < 0.13, + ieee754 >= 0.8.0 && < 0.9, + lens >= 5.2.3 && < 5.3, + parallel >= 3.2.2 && < 3.3, + math-functions >= 0.3.4 && < 0.4, + monad-loops >= 0.4.3 && < 0.5, + numeric-limits >= 0.1.0 && < 0.2, + openapi3 >= 3.2.4 && < 3.3, + regex-pcre-builtin >= 0.95.2 && < 0.96, + regex-tdfa >= 1.3.2 && < 1.4, + servant >= 0.20.3 && < 0.21, + servant-openapi3 >= 2.0.1 && < 2.1, + servant-server >= 0.20.3 && < 0.21, + wai >= 3.2.4 && < 3.3, + warp >= 3.4.8 && < 3.5, + split >= 0.2.5 && < 0.3, + string-conversions >= 0.4.0 && < 0.5, + swagger2 >= 2.8.10 && < 2.9, + tabular >= 0.2.2 && < 0.3, + wai-cors >= 0.2.7 && < 0.3, + yaml >= 0.11.11 && < 0.12, + + default-language: Haskell2010 executable Hastructure-exe @@ -132,50 +133,50 @@ executable Hastructure-exe app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - Decimal - , Hastructure - , aeson - , aeson-pretty - , attoparsec - , attoparsec-aeson - , base - , base-compat - , bytestring - , containers - , deepseq - , exceptions - , generic-lens - , hashable - , http-types - , ieee754 - , lens - , math-functions - , monad-loops - , mtl - , numeric-limits - , openapi3 - , parallel - , regex-base - , regex-pcre-builtin - , regex-tdfa - , scientific - , servant - , servant-openapi3 - , servant-server - , split - , string-conversions - , swagger2 - , tabular - , template-haskell - , text - , time - , unordered-containers >= 0.2 && < 0.2.20 - , wai - , wai-cors - , warp - , yaml - , dlist --- , proto3-suite + Decimal >= 0.5.2 && < 0.6, + base >= 4.19.2 && < 4.20, + deepseq >= 1.5.1 && < 1.6, + MissingH >= 1.6.0 && < 1.7, + containers >= 0.6.8 && < 0.7, + template-haskell >= 2.21.0 && < 2.22, + bytestring >= 0.12.1 && < 0.13, + exceptions >= 0.10.7 && < 0.11, + mtl >= 2.3.1 && < 2.4, + time >= 1.12.2 && < 1.13, + text >= 2.1.1 && < 2.2, + regex-base >= 0.94.0 && < 0.95, + aeson >= 2.2.3 && < 2.3, + hashable >= 1.4.7 && < 1.5, + dlist >= 1.0 && < 1.1, + scientific >= 0.3.8 && < 0.4, + vector >= 0.13.2 && < 0.14, + aeson-pretty >= 0.8.10 && < 0.9, + base-compat >= 0.14.1 && < 0.15, + attoparsec >= 0.14.4 && < 0.15, + attoparsec-aeson >= 2.2.2 && < 2.3, + generic-lens >= 2.2.2 && < 2.3, + http-types >= 0.12.4 && < 0.13, + ieee754 >= 0.8.0 && < 0.9, + lens >= 5.2.3 && < 5.3, + parallel >= 3.2.2 && < 3.3, + math-functions >= 0.3.4 && < 0.4, + monad-loops >= 0.4.3 && < 0.5, + numeric-limits >= 0.1.0 && < 0.2, + openapi3 >= 3.2.4 && < 3.3, + regex-pcre-builtin >= 0.95.2 && < 0.96, + regex-tdfa >= 1.3.2 && < 1.4, + servant >= 0.20.3 && < 0.21, + servant-openapi3 >= 2.0.1 && < 2.1, + servant-server >= 0.20.3 && < 0.21, + wai >= 3.2.4 && < 3.3, + warp >= 3.4.8 && < 3.5, + split >= 0.2.5 && < 0.3, + string-conversions >= 0.4.0 && < 0.5, + swagger2 >= 2.8.10 && < 2.9, + tabular >= 0.2.2 && < 0.3, + wai-cors >= 0.2.7 && < 0.3, + yaml >= 0.11.11 && < 0.12, + default-language: Haskell2010 test-suite Hastructure-test @@ -208,44 +209,47 @@ test-suite Hastructure-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - Decimal - , Hastructure - , aeson - , aeson-pretty - , base - , bytestring - , containers - , deepseq - , generic-lens - , hashable - , ieee754 - , lens - , math-functions - , monad-loops - , mtl - , numeric-limits - , openapi3 - , parallel - , regex-base - , regex-pcre-builtin - , regex-tdfa - , scientific - , servant - , servant-openapi3 - , servant-server - , split - , swagger2 - , tabular - , tasty - , tasty-golden - , tasty-hspec - , tasty-hunit - , template-haskell - , text - , time - , wai - , yaml - , vector - , MissingH - , dlist + Decimal >= 0.5.2 && < 0.6, + base >= 4.19.2 && < 4.20, + deepseq >= 1.5.1 && < 1.6, + MissingH >= 1.6.0 && < 1.7, + containers >= 0.6.8 && < 0.7, + template-haskell >= 2.21.0 && < 2.22, + bytestring >= 0.12.1 && < 0.13, + exceptions >= 0.10.7 && < 0.11, + mtl >= 2.3.1 && < 2.4, + time >= 1.12.2 && < 1.13, + text >= 2.1.1 && < 2.2, + regex-base >= 0.94.0 && < 0.95, + aeson >= 2.2.3 && < 2.3, + hashable >= 1.4.7 && < 1.5, + dlist >= 1.0 && < 1.1, + scientific >= 0.3.8 && < 0.4, + vector >= 0.13.2 && < 0.14, + aeson-pretty >= 0.8.10 && < 0.9, + base-compat >= 0.14.1 && < 0.15, + attoparsec >= 0.14.4 && < 0.15, + attoparsec-aeson >= 2.2.2 && < 2.3, + generic-lens >= 2.2.2 && < 2.3, + http-types >= 0.12.4 && < 0.13, + ieee754 >= 0.8.0 && < 0.9, + lens >= 5.2.3 && < 5.3, + parallel >= 3.2.2 && < 3.3, + math-functions >= 0.3.4 && < 0.4, + monad-loops >= 0.4.3 && < 0.5, + numeric-limits >= 0.1.0 && < 0.2, + openapi3 >= 3.2.4 && < 3.3, + regex-pcre-builtin >= 0.95.2 && < 0.96, + regex-tdfa >= 1.3.2 && < 1.4, + servant >= 0.20.3 && < 0.21, + servant-openapi3 >= 2.0.1 && < 2.1, + servant-server >= 0.20.3 && < 0.21, + wai >= 3.2.4 && < 3.3, + warp >= 3.4.8 && < 3.5, + split >= 0.2.5 && < 0.3, + string-conversions >= 0.4.0 && < 0.5, + swagger2 >= 2.8.10 && < 2.9, + tabular >= 0.2.2 && < 0.3, + wai-cors >= 0.2.7 && < 0.3, + yaml >= 0.11.11 && < 0.12, default-language: Haskell2010 From 8e97e42f08fcd0c7f83b632d51fb6237a53ec55c Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 01:21:19 +0800 Subject: [PATCH 35/49] remove duplicate version cons --- Hastructure.cabal | 172 +++++++++++++++++++++++----------------------- 1 file changed, 86 insertions(+), 86 deletions(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index fc4f4dfa..3abc269f 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -133,49 +133,49 @@ executable Hastructure-exe app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - Decimal >= 0.5.2 && < 0.6, - base >= 4.19.2 && < 4.20, - deepseq >= 1.5.1 && < 1.6, - MissingH >= 1.6.0 && < 1.7, - containers >= 0.6.8 && < 0.7, - template-haskell >= 2.21.0 && < 2.22, - bytestring >= 0.12.1 && < 0.13, - exceptions >= 0.10.7 && < 0.11, - mtl >= 2.3.1 && < 2.4, - time >= 1.12.2 && < 1.13, - text >= 2.1.1 && < 2.2, - regex-base >= 0.94.0 && < 0.95, - aeson >= 2.2.3 && < 2.3, - hashable >= 1.4.7 && < 1.5, - dlist >= 1.0 && < 1.1, - scientific >= 0.3.8 && < 0.4, - vector >= 0.13.2 && < 0.14, - aeson-pretty >= 0.8.10 && < 0.9, - base-compat >= 0.14.1 && < 0.15, - attoparsec >= 0.14.4 && < 0.15, - attoparsec-aeson >= 2.2.2 && < 2.3, - generic-lens >= 2.2.2 && < 2.3, - http-types >= 0.12.4 && < 0.13, - ieee754 >= 0.8.0 && < 0.9, - lens >= 5.2.3 && < 5.3, - parallel >= 3.2.2 && < 3.3, - math-functions >= 0.3.4 && < 0.4, - monad-loops >= 0.4.3 && < 0.5, - numeric-limits >= 0.1.0 && < 0.2, - openapi3 >= 3.2.4 && < 3.3, - regex-pcre-builtin >= 0.95.2 && < 0.96, - regex-tdfa >= 1.3.2 && < 1.4, - servant >= 0.20.3 && < 0.21, - servant-openapi3 >= 2.0.1 && < 2.1, - servant-server >= 0.20.3 && < 0.21, - wai >= 3.2.4 && < 3.3, - warp >= 3.4.8 && < 3.5, - split >= 0.2.5 && < 0.3, - string-conversions >= 0.4.0 && < 0.5, - swagger2 >= 2.8.10 && < 2.9, - tabular >= 0.2.2 && < 0.3, - wai-cors >= 0.2.7 && < 0.3, - yaml >= 0.11.11 && < 0.12, + Decimal, + base, + deepseq, + MissingH, + containers, + template-haskell, + bytestring, + exceptions, + mtl, + time, + text, + regex-base, + aeson, + hashable, + dlist, + scientific, + vector, + aeson-pretty, + base-compat, + attoparsec, + attoparsec-aeson, + generic-lens, + http-types, + ieee754, + lens, + parallel, + math-functions, + monad-loops, + numeric-limits, + openapi3, + regex-pcre-builtin, + regex-tdfa, + servant, + servant-openapi3, + servant-server, + wai, + warp, + split, + string-conversions, + swagger2, + tabular, + wai-cors, + yaml, default-language: Haskell2010 @@ -209,47 +209,47 @@ test-suite Hastructure-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - Decimal >= 0.5.2 && < 0.6, - base >= 4.19.2 && < 4.20, - deepseq >= 1.5.1 && < 1.6, - MissingH >= 1.6.0 && < 1.7, - containers >= 0.6.8 && < 0.7, - template-haskell >= 2.21.0 && < 2.22, - bytestring >= 0.12.1 && < 0.13, - exceptions >= 0.10.7 && < 0.11, - mtl >= 2.3.1 && < 2.4, - time >= 1.12.2 && < 1.13, - text >= 2.1.1 && < 2.2, - regex-base >= 0.94.0 && < 0.95, - aeson >= 2.2.3 && < 2.3, - hashable >= 1.4.7 && < 1.5, - dlist >= 1.0 && < 1.1, - scientific >= 0.3.8 && < 0.4, - vector >= 0.13.2 && < 0.14, - aeson-pretty >= 0.8.10 && < 0.9, - base-compat >= 0.14.1 && < 0.15, - attoparsec >= 0.14.4 && < 0.15, - attoparsec-aeson >= 2.2.2 && < 2.3, - generic-lens >= 2.2.2 && < 2.3, - http-types >= 0.12.4 && < 0.13, - ieee754 >= 0.8.0 && < 0.9, - lens >= 5.2.3 && < 5.3, - parallel >= 3.2.2 && < 3.3, - math-functions >= 0.3.4 && < 0.4, - monad-loops >= 0.4.3 && < 0.5, - numeric-limits >= 0.1.0 && < 0.2, - openapi3 >= 3.2.4 && < 3.3, - regex-pcre-builtin >= 0.95.2 && < 0.96, - regex-tdfa >= 1.3.2 && < 1.4, - servant >= 0.20.3 && < 0.21, - servant-openapi3 >= 2.0.1 && < 2.1, - servant-server >= 0.20.3 && < 0.21, - wai >= 3.2.4 && < 3.3, - warp >= 3.4.8 && < 3.5, - split >= 0.2.5 && < 0.3, - string-conversions >= 0.4.0 && < 0.5, - swagger2 >= 2.8.10 && < 2.9, - tabular >= 0.2.2 && < 0.3, - wai-cors >= 0.2.7 && < 0.3, - yaml >= 0.11.11 && < 0.12, + Decimal, + base, + deepseq, + MissingH, + containers, + template-haskell, + bytestring, + exceptions, + mtl, + time, + text, + regex-base, + aeson, + hashable, + dlist, + scientific, + vector, + aeson-pretty, + base-compat, + attoparsec, + attoparsec-aeson, + generic-lens, + http-types, + ieee754, + lens, + parallel, + math-functions, + monad-loops, + numeric-limits, + openapi3, + regex-pcre-builtin, + regex-tdfa, + servant, + servant-openapi3, + servant-server, + wai, + warp, + split, + string-conversions, + swagger2, + tabular, + wai-cors, + yaml, default-language: Haskell2010 From 32ceb86635fa088b49fed9c50c05ba25b11961f6 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 01:38:29 +0800 Subject: [PATCH 36/49] add Test Library --- Hastructure.cabal | 5 +++++ test/UT/BondTest.hs | 2 ++ 2 files changed, 7 insertions(+) diff --git a/Hastructure.cabal b/Hastructure.cabal index 3abc269f..ed62afb7 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -209,6 +209,7 @@ test-suite Hastructure-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: + Hastructure, Decimal, base, deepseq, @@ -252,4 +253,8 @@ test-suite Hastructure-test tabular, wai-cors, yaml, + tasty, + tasty-golden, + tasty-hspec, + tasty-hunit default-language: Haskell2010 diff --git a/test/UT/BondTest.hs b/test/UT/BondTest.hs index e60fad4c..e935d8c2 100644 --- a/test/UT/BondTest.hs +++ b/test/UT/BondTest.hs @@ -33,6 +33,7 @@ b1 = B.Bond{B.bndName="A" ,B.bndBalance=3000 ,B.bndRate=0.08 ,B.bndDuePrin=0.0 + ,B.bndStepUp = Nothing ,B.bndDueInt=0.0 ,B.bndDueIntOverInt=0.0 ,B.bndDueIntDate=Nothing @@ -50,6 +51,7 @@ bfloat = B.Bond{B.bndName="A" ,B.bndInterestInfo= B.Floater 0.02 LPR5Y 0.015 (MonthDayOfYear 1 1) DC_ACT_365F Nothing Nothing ,B.bndBalance=3000 ,B.bndRate=0.08 + ,B.bndStepUp = Nothing ,B.bndDuePrin=0.0 ,B.bndDueInt=0.0 ,B.bndDueIntDate=Nothing From 421fb72740e35c4abdc3c3ebfbb0acd59383c9f7 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 10:50:59 +0800 Subject: [PATCH 37/49] add base version constrain --- Hastructure.cabal | 4 ++-- test/UT/BondTest.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index ed62afb7..891fa9cc 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -134,7 +134,7 @@ executable Hastructure-exe ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: Decimal, - base, + base >= 4.19.2 && < 4.20, deepseq, MissingH, containers, @@ -211,7 +211,7 @@ test-suite Hastructure-test build-depends: Hastructure, Decimal, - base, + base >= 4.19.2 && < 4.20, deepseq, MissingH, containers, diff --git a/test/UT/BondTest.hs b/test/UT/BondTest.hs index e935d8c2..6b87cc7e 100644 --- a/test/UT/BondTest.hs +++ b/test/UT/BondTest.hs @@ -51,7 +51,7 @@ bfloat = B.Bond{B.bndName="A" ,B.bndInterestInfo= B.Floater 0.02 LPR5Y 0.015 (MonthDayOfYear 1 1) DC_ACT_365F Nothing Nothing ,B.bndBalance=3000 ,B.bndRate=0.08 - ,B.bndStepUp = Nothing + ,B.bndStepUp = Nothing ,B.bndDuePrin=0.0 ,B.bndDueInt=0.0 ,B.bndDueIntDate=Nothing From 2fd1355d1e04368cae285539d25c54fddb8d3c25 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 11:38:50 +0800 Subject: [PATCH 38/49] fix base version --- Hastructure.cabal | 12 ++++++++---- README.md | 1 + 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index 891fa9cc..f4f2c9e5 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -8,7 +8,7 @@ name: Hastructure version: 0.45.0 synopsis: Cashflow modeling library for structured finance description: Please see the README on GitHub at -category: StructuredFinance;Securitisation;Cashflow +category: StructuredFinance,Securitisation,Cashflow homepage: https://github.com/yellowbean/Hastructure#readme bug-reports: https://github.com/yellowbean/Hastructure/issues author: Xiaoyu @@ -76,7 +76,7 @@ library src build-depends: Decimal >= 0.5.2 && < 0.6, - base >= 4.19.2 && < 4.20, + base >= 4.18.0 && < 4.20, deepseq >= 1.5.1 && < 1.6, MissingH >= 1.6.0 && < 1.7, containers >= 0.6.8 && < 0.7, @@ -134,7 +134,7 @@ executable Hastructure-exe ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: Decimal, - base >= 4.19.2 && < 4.20, + base >= 4.18.0 && < 4.20, deepseq, MissingH, containers, @@ -176,6 +176,10 @@ executable Hastructure-exe tabular, wai-cors, yaml, + tasty >= 1.5.3 && < 1.6, + tasty-golden >= 2.3.5 && < 2.4, + tasty-hspec >= 1.2.0 && < 1.3, + tasty-hunit >= 0.10.2 && < 0.11, default-language: Haskell2010 @@ -211,7 +215,7 @@ test-suite Hastructure-test build-depends: Hastructure, Decimal, - base >= 4.19.2 && < 4.20, + base >= 4.18.0 && < 4.20, deepseq, MissingH, containers, diff --git a/README.md b/README.md index 5c24f855..e45d3d69 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ [![Actions Status](https://github.com/yellowbean/Hastructure/workflows/Haskell%20CI/badge.svg)](https://github.com/yellowbean/Hastructure/actions) [![Docker Build](https://img.shields.io/docker/v/yellowbean/hastructure?color=green&label=docker)](https://hub.docker.com/r/yellowbean/hastructure) [![Pulls from DockerHub](https://img.shields.io/docker/pulls/yellowbean/hastructure.svg)](https://hub.docker.com/r/yellowbean/hastructure) +![Hackage Version](https://img.shields.io/hackage/v/Hastructure) # What is Hastructure ? From e8a07c2e4f1b87e232e8b9ad33453e32609b484a Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 11:50:40 +0800 Subject: [PATCH 39/49] update template-haskell --- Hastructure.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index f4f2c9e5..3e458f25 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -80,7 +80,7 @@ library deepseq >= 1.5.1 && < 1.6, MissingH >= 1.6.0 && < 1.7, containers >= 0.6.8 && < 0.7, - template-haskell >= 2.21.0 && < 2.22, + template-haskell >= 2.20.0 && < 2.22, bytestring >= 0.12.1 && < 0.13, exceptions >= 0.10.7 && < 0.11, mtl >= 2.3.1 && < 2.4, From f9521db0ef9c937cfe0b8777ce2709649cb668bc Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 13:59:03 +0800 Subject: [PATCH 40/49] update workflow --- .github/workflows/haskell.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index d67e65da..d1da3ca9 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -16,7 +16,7 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2.8.0 with: ghc-version: 'latest' cabal-version: 'latest' @@ -44,4 +44,4 @@ jobs: - name: Badge Action uses: emibcn/badge-action@v1.2.4 - \ No newline at end of file + From 0db527e5b4dd9d34aae8d16909a6ce6896c5b5c2 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 14:56:06 +0800 Subject: [PATCH 41/49] update wkflow for ghc version --- .github/workflows/haskell.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index d1da3ca9..0a1e7663 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -18,7 +18,7 @@ jobs: - uses: actions/checkout@v3 - uses: haskell-actions/setup@v2.8.0 with: - ghc-version: 'latest' + ghc-version: '9.8.4' cabal-version: 'latest' - name: Cache @@ -33,7 +33,7 @@ jobs: ${{ runner.os }}-build- ${{ runner.os }}- - - name: Install dependencies + - name: Install deendencies run: | cabal update - name: Build From bd2fdf2eb1dddfee981961d186caec3203431f61 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 10 Jul 2025 15:40:02 +0800 Subject: [PATCH 42/49] add lib to exe --- Hastructure.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/Hastructure.cabal b/Hastructure.cabal index 3e458f25..9880d68d 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -133,6 +133,7 @@ executable Hastructure-exe app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: + Hastructure, Decimal, base >= 4.18.0 && < 4.20, deepseq, From b0399e5932f58ac9fca5d52911fce4c265da83fd Mon Sep 17 00:00:00 2001 From: yellowbean Date: Sun, 13 Jul 2025 11:34:48 +0800 Subject: [PATCH 43/49] update --- Hastructure.cabal | 14 +++++------ Hastructure.nix | 50 ++++++++++++++++++++++++++++++++++++++ release.nix | 30 +++++++++++++++++++++++ src/Deal/DealValidation.hs | 1 + test/UT/CashflowTest.hs | 8 ------ 5 files changed, 88 insertions(+), 15 deletions(-) create mode 100644 Hastructure.nix create mode 100644 release.nix diff --git a/Hastructure.cabal b/Hastructure.cabal index 9880d68d..6892d0ce 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -5,7 +5,7 @@ cabal-version: 3.0 -- see: https://github.com/sol/hpack name: Hastructure -version: 0.45.0 +version: 0.45.3 synopsis: Cashflow modeling library for structured finance description: Please see the README on GitHub at category: StructuredFinance,Securitisation,Cashflow @@ -93,13 +93,13 @@ library scientific >= 0.3.8 && < 0.4, vector >= 0.13.2 && < 0.14, aeson-pretty >= 0.8.10 && < 0.9, - base-compat >= 0.14.1 && < 0.15, + base-compat >= 0.13.0 && < 0.15, attoparsec >= 0.14.4 && < 0.15, attoparsec-aeson >= 2.2.2 && < 2.3, generic-lens >= 2.2.2 && < 2.3, http-types >= 0.12.4 && < 0.13, ieee754 >= 0.8.0 && < 0.9, - lens >= 5.2.3 && < 5.3, + lens >= 5.2.3 && < 5.3.5, parallel >= 3.2.2 && < 3.3, math-functions >= 0.3.4 && < 0.4, monad-loops >= 0.4.3 && < 0.5, @@ -107,14 +107,14 @@ library openapi3 >= 3.2.4 && < 3.3, regex-pcre-builtin >= 0.95.2 && < 0.96, regex-tdfa >= 1.3.2 && < 1.4, - servant >= 0.20.3 && < 0.21, + servant >= 0.20.2 && < 0.21, servant-openapi3 >= 2.0.1 && < 2.1, - servant-server >= 0.20.3 && < 0.21, + servant-server >= 0.20.2 && < 0.21, wai >= 3.2.4 && < 3.3, - warp >= 3.4.8 && < 3.5, + warp >= 3.4.7 && < 3.5, split >= 0.2.5 && < 0.3, string-conversions >= 0.4.0 && < 0.5, - swagger2 >= 2.8.10 && < 2.9, + swagger2 >= 2.8.9 && < 2.9, tabular >= 0.2.2 && < 0.3, wai-cors >= 0.2.7 && < 0.3, yaml >= 0.11.11 && < 0.12, diff --git a/Hastructure.nix b/Hastructure.nix new file mode 100644 index 00000000..dbaeebd6 --- /dev/null +++ b/Hastructure.nix @@ -0,0 +1,50 @@ +{ mkDerivation, aeson, aeson-pretty, attoparsec, attoparsec-aeson +, base, base-compat, bytestring, containers, Decimal, deepseq +, dlist, exceptions, generic-lens, hashable, http-types, ieee754 +, lens, lib, math-functions, MissingH, monad-loops, mtl +, numeric-limits, openapi3, parallel, regex-base +, regex-pcre-builtin, regex-tdfa, scientific, servant +, servant-openapi3, servant-server, split, string-conversions +, swagger2, tabular, tasty, tasty-golden, tasty-hspec, tasty-hunit +, template-haskell, text, time, vector, wai, wai-cors, warp, yaml +}: +mkDerivation { + pname = "Hastructure"; + version = "0.45.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + aeson aeson-pretty attoparsec attoparsec-aeson base base-compat + bytestring containers Decimal deepseq dlist exceptions generic-lens + hashable http-types ieee754 lens math-functions MissingH + monad-loops mtl numeric-limits openapi3 parallel regex-base + regex-pcre-builtin regex-tdfa scientific servant servant-openapi3 + servant-server split string-conversions swagger2 tabular + template-haskell text time vector wai wai-cors warp yaml + ]; + executableHaskellDepends = [ + aeson aeson-pretty attoparsec attoparsec-aeson base base-compat + bytestring containers Decimal deepseq dlist exceptions generic-lens + hashable http-types ieee754 lens math-functions MissingH + monad-loops mtl numeric-limits openapi3 parallel regex-base + regex-pcre-builtin regex-tdfa scientific servant servant-openapi3 + servant-server split string-conversions swagger2 tabular tasty + tasty-golden tasty-hspec tasty-hunit template-haskell text time + vector wai wai-cors warp yaml + ]; + testHaskellDepends = [ + aeson aeson-pretty attoparsec attoparsec-aeson base base-compat + bytestring containers Decimal deepseq dlist exceptions generic-lens + hashable http-types ieee754 lens math-functions MissingH + monad-loops mtl numeric-limits openapi3 parallel regex-base + regex-pcre-builtin regex-tdfa scientific servant servant-openapi3 + servant-server split string-conversions swagger2 tabular tasty + tasty-golden tasty-hspec tasty-hunit template-haskell text time + vector wai wai-cors warp yaml + ]; + homepage = "https://github.com/yellowbean/Hastructure#readme"; + description = "Cashflow modeling library for structured finance"; + license = lib.licenses.bsd3; + mainProgram = "Hastructure-exe"; +} diff --git a/release.nix b/release.nix new file mode 100644 index 00000000..0ef4bd40 --- /dev/null +++ b/release.nix @@ -0,0 +1,30 @@ +{ nixpkgs ? import (fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/refs/tags/25.05.tar.gz"; + sha256 = "1915r28xc4znrh2vf4rrjnxldw2imysz819gzhk9qlrkqanmfsxd"; # Replace with actual hash + }) {} +}: +let + # Use the Haskell package set from nixpkgs + haskellPackages = nixpkgs.haskellPackages; + + # Define the project + hastructure = haskellPackages.callCabal2nix "Hastructure" ./. {}; +in +{ + # Expose the project derivation + hastructure = hastructure; + + # Development shell for interactive work + shell = haskellPackages.shellFor { + packages = p: [hastructure]; + buildInputs = with haskellPackages; [ + cabal-install + ghc + haskell-language-server + ]; + }; + + installPhase = '' + cp config.yaml $out/bin/ + }; +} diff --git a/src/Deal/DealValidation.hs b/src/Deal/DealValidation.hs index 23b44a46..427553fc 100644 --- a/src/Deal/DealValidation.hs +++ b/src/Deal/DealValidation.hs @@ -485,6 +485,7 @@ validatePreRun t@TestDeal{waterfall=waterfallM in (warnings,allErrors) -- Valiation Pass +-- validate deal object after run validateRun :: TestDeal a -> [ResultComponent] validateRun t@TestDeal{waterfall=waterfallM ,accounts =accM diff --git a/test/UT/CashflowTest.hs b/test/UT/CashflowTest.hs index c2603f52..619f788d 100644 --- a/test/UT/CashflowTest.hs +++ b/test/UT/CashflowTest.hs @@ -123,14 +123,6 @@ tsSplitTests = assertEqual "Keep previous one" ([],[cf1,cf2, cf3,cf4]) $ splitByDate ts1 (L.toDate "20230201") EqToLeftKeepOne - -- ,testCase "CashflowFrame" $ - -- assertEqual "Slice on Cashflow Frame" - -- (CF.CashFlowFrame [cf1,cf2],CF.CashFlowFrame [cf3,cf4]) $ - -- CF.splitCashFlowFrameByDate cff (L.toDate "20230215") EqToLeft - -- ,testCase "CashflowFrame" $ - -- assertEqual "Slice on Cashflow Frame" - -- (CF.CashFlowFrame [cf1,cf2,cf3],CF.CashFlowFrame [cf4]) $ - -- CF.splitCashFlowFrameByDate cff (L.toDate "20230301") EqToLeft ,testCase "Range of Ts" $ assertEqual "get subset of Ts between two dates" [cf2, cf3,cf4] $ From d198b8312cb03b9610c9055ad7d44b43be595c60 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 14 Jul 2025 12:51:14 +0800 Subject: [PATCH 44/49] FIX: oustanding pool check --- .github/workflows/docker-image.yml | 10 +++++++++- .github/workflows/haskell.yml | 2 +- Hastructure.cabal | 6 +++--- src/Cashflow.hs | 16 ++++++++-------- src/Deal.hs | 15 +++++++++------ src/Deal/DealAction.hs | 4 ++-- 6 files changed, 32 insertions(+), 21 deletions(-) diff --git a/.github/workflows/docker-image.yml b/.github/workflows/docker-image.yml index e6080c82..cee10199 100644 --- a/.github/workflows/docker-image.yml +++ b/.github/workflows/docker-image.yml @@ -157,4 +157,12 @@ jobs: tags: ${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:latest, ${{ steps.meta.outputs.tags }} cache-from: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache cache-to: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache,mode=max - \ No newline at end of file + + publish: + + - uses: haskell-actions/hackage-publish@v1 + with: + hackageToken: ${{ secrets.HACKAGE_KEY }} + packagesPath: ${{ runner.temp }}/packages + docsPath: ${{ runner.temp }}/docs + publish: false diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 0a1e7663..9266ea20 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -33,7 +33,7 @@ jobs: ${{ runner.os }}-build- ${{ runner.os }}- - - name: Install deendencies + - name: Install depndencies run: | cabal update - name: Build diff --git a/Hastructure.cabal b/Hastructure.cabal index 6892d0ce..dbc85d4f 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -76,11 +76,11 @@ library src build-depends: Decimal >= 0.5.2 && < 0.6, - base >= 4.18.0 && < 4.20, + base >= 4.18.0 && < 4.21, deepseq >= 1.5.1 && < 1.6, MissingH >= 1.6.0 && < 1.7, containers >= 0.6.8 && < 0.7, - template-haskell >= 2.20.0 && < 2.22, + template-haskell >= 2.20.0 && < 2.21.1.0, bytestring >= 0.12.1 && < 0.13, exceptions >= 0.10.7 && < 0.11, mtl >= 2.3.1 && < 2.4, @@ -99,7 +99,7 @@ library generic-lens >= 2.2.2 && < 2.3, http-types >= 0.12.4 && < 0.13, ieee754 >= 0.8.0 && < 0.9, - lens >= 5.2.3 && < 5.3.5, + lens >= 5.2.3 && < 5.3.6, parallel >= 3.2.2 && < 3.3, math-functions >= 0.3.4 && < 0.4, monad-loops >= 0.4.3 && < 0.5, diff --git a/src/Cashflow.hs b/src/Cashflow.hs index ba175c41..7a0ae04d 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -25,10 +25,10 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,mergeCf,buildStartTsRow ,txnCumulativeStats,consolidateCashFlow, cfBeginStatus, getBegBalCashFlowFrame ,splitCashFlowFrameByDate, mergePoolCf2, buildBegBal, extendCashFlow, patchBalance - ,splitPoolCashflowByDate + ,splitPoolCashflowByDate ,getAllDatesCashFlowFrame,splitCf, cutoffCashflow - ,AssetCashflow,PoolCashflow - ,emptyCashflow,isEmptyRow2 + ,AssetCashflow,PoolCashflow + ,emptyCashflow,isEmptyRow2 ) where import Data.Time (Day) @@ -269,23 +269,23 @@ splitCashFlowFrameByDate (CashFlowFrame status txns) d st (ls,rs) = splitByDate txns d st newStatus = case rs of [] -> (0, d, Nothing) - (r:_) -> (mflowBegBalance r, d, Nothing) + (r:_) -> (buildBegBal rs, d, Nothing) in (CashFlowFrame status ls,CashFlowFrame newStatus rs) + splitPoolCashflowByDate :: PoolCashflow -> Date -> SplitType -> (PoolCashflow,PoolCashflow) splitPoolCashflowByDate (poolCF, mAssetCfs) d st = let (lPoolCF,rPoolCF) = splitCashFlowFrameByDate poolCF d st mAssetSplited = (\xs -> [ splitCashFlowFrameByDate x d st | x <- xs ]) <$> mAssetCfs assetCfs = (\xs -> [ (lCf, rCf) | (lCf,rCf) <- xs ]) <$> mAssetSplited - lAssetCfs = (\xs -> fst <$> xs ) <$> assetCfs - rAssetCfs = (\xs -> snd <$> xs ) <$> assetCfs + lAssetCfs = (fst <$>) <$> assetCfs + rAssetCfs = (snd <$>) <$> assetCfs in ((lPoolCF, lAssetCfs) , (rPoolCF, rAssetCfs)) - getTxnLatestAsOf :: CashFlowFrame -> Date -> Maybe TsRow getTxnLatestAsOf (CashFlowFrame _ txn) d = L.find (\x -> getDate x <= d) $ reverse txn @@ -425,7 +425,7 @@ addTsCF (ReceivableFlow d1 b1 af1 p1 fp1 def1 rec1 los1 st1) (ReceivableFlow d2 buildBegBal :: [TsRow] -> Balance buildBegBal [] = 0 -buildBegBal (x:_) = mflowBegBalance x +buildBegBal (x:xs) = mflowBegBalance x sumTs :: [TsRow] -> Date -> TsRow diff --git a/src/Deal.hs b/src/Deal.hs index 47bcdf2a..4c039e3f 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -1020,15 +1020,16 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts let poolFlowUsedNoEmpty = Map.map (over CF.cashflowTxn CF.dropTailEmptyTxns) (getAllCollectedFrame finalDeal Nothing) + let poolFlowUnUsed = osPoolFlow & mapped . _1 . CF.cashflowTxn %~ CF.dropTailEmptyTxns + & mapped . _2 . _Just . each . CF.cashflowTxn %~ CF.dropTailEmptyTxns bndPricing <- case mPricing of (Just p) -> priceBonds finalDeal p Nothing -> Right Map.empty return (finalDeal , poolFlowUsedNoEmpty - , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList (DL.append logs (unCollectedPoolFlowWarning osPoolFlow)) + , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList (DL.append logs (unCollectedPoolFlowWarning poolFlowUnUsed)) , bndPricing - , osPoolFlow & mapped . _1 . CF.cashflowTxn %~ CF.dropTailEmptyTxns - & mapped . _2 . _Just . each . CF.cashflowTxn %~ CF.dropTailEmptyTxns + , poolFlowUnUsed ) -- `debug` ("run deal done with pool" ++ show poolFlowUsedNoEmpty) where (runFlag, valLogs) = V.validateReq t nonPerfAssumps @@ -1038,9 +1039,11 @@ runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts Nothing -> Nothing Just (AP.AvailableAssets rp rperf) -> Just (Map.fromList [("Consol", (rp, rperf))]) Just (AP.AvailableAssetsBy rMap) -> Just rMap - -- TODO: need to add warning if uncollected pool flow is not empty - unCollectedPoolFlowWarning pMap = if sum (Map.elems (Map.map (CF.sizeCashFlowFrame . view _1) pMap)) > 0 then - DL.singleton $ WarningMsg "Oustanding pool cashflow hasn't been collected yet" + unCollectedPoolFlowWarning pMap = let + countMap = Map.map (CF.sizeCashFlowFrame . view _1) pMap + in + if sum (Map.elems countMap) > 0 then + DL.singleton $ WarningMsg $ "Oustanding pool cashflow hasn't been collected yet"++ show countMap else DL.empty diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index baeb8dc7..975029e1 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -573,7 +573,7 @@ performActionWrap d boughtCfDates = getDate <$> view CF.cashflowTxn cfBought newAggDates = case (dsInterval,boughtCfDates) of ([],[]) -> [] - (_,[]) -> [] -- `debug` ("hit with non cash date from bought"++ show dsInterval) + (_,[]) -> [] ([],_) -> boughtCfDates (oDs,bDs) -> let @@ -584,7 +584,7 @@ performActionWrap d [] else sliceDates (SliceAfter lastOdate) bDs - + -- TODO: the cfOrigin may not have correct beg balance ,which doesn't match all the amortization of cashflow txn mergedCf = CF.mergePoolCf2 cfOrigin cfBought in ((over CF.cashflowTxn (`CF.aggTsByDates` (dsInterval ++ newAggDates)) mergedCf), (++ [cfBought]) <$> mAflow) From 468a43a20c30eb7b97f8df43d427f88da868e020 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 14 Jul 2025 13:14:51 +0800 Subject: [PATCH 45/49] bump version to-> < 0.50.0 > --- CHANGELOG.md | 10 ++++++++++ app/Main.hs | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 49d2db0d..7d9787bb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,16 @@ +## 0.50.0 +### 2025-07-14 +* NEW: add `stopBy` in run assumption ,which stop deal run by a list of `Condition` +* NEW: expose `asset level` cashflow ,with a toggle +* NEW: expose `Un-Used Pool cashflow` +* ENHANCE: parameterized the `tweaks` +* ENHANCE: update dependency to accomodate publishment to `Hackage` +* FIX: enable `Lease` deal for `Financial reports` + + ## 0.46.4 ### 2025-06-10 * ENHANCE: add error message when calculation IRR for bond with non cashflow diff --git a/app/Main.hs b/app/Main.hs index d9669dd9..71378414 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -104,7 +104,7 @@ debug = flip Debug.Trace.trace version1 :: Version -version1 = Version "0.46.4" +version1 = Version "0.50.0" wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp From 71aa723168ff7082e8402bbc71bd1841108cfe32 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 14 Jul 2025 15:40:47 +0800 Subject: [PATCH 46/49] clean up --- Hastructure.cabal | 14 +++++--------- src/Deal.hs | 2 +- src/Deal/DealAction.hs | 2 +- src/Deal/DealBase.hs | 1 - src/Deal/DealMod.hs | 4 ++-- src/Lib.hs | 4 ++-- 6 files changed, 11 insertions(+), 16 deletions(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index dbc85d4f..93cbee50 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -5,7 +5,7 @@ cabal-version: 3.0 -- see: https://github.com/sol/hpack name: Hastructure -version: 0.45.3 +version: 0.50.0 synopsis: Cashflow modeling library for structured finance description: Please see the README on GitHub at category: StructuredFinance,Securitisation,Cashflow @@ -82,7 +82,7 @@ library containers >= 0.6.8 && < 0.7, template-haskell >= 2.20.0 && < 2.21.1.0, bytestring >= 0.12.1 && < 0.13, - exceptions >= 0.10.7 && < 0.11, + -- exceptions >= 0.10.7 && < 0.11, mtl >= 2.3.1 && < 2.4, time >= 1.12.2 && < 1.13, text >= 2.1.1 && < 2.2, @@ -98,7 +98,7 @@ library attoparsec-aeson >= 2.2.2 && < 2.3, generic-lens >= 2.2.2 && < 2.3, http-types >= 0.12.4 && < 0.13, - ieee754 >= 0.8.0 && < 0.9, + -- ieee754 >= 0.8.0 && < 0.9, lens >= 5.2.3 && < 5.3.6, parallel >= 3.2.2 && < 3.3, math-functions >= 0.3.4 && < 0.4, @@ -106,7 +106,7 @@ library numeric-limits >= 0.1.0 && < 0.2, openapi3 >= 3.2.4 && < 3.3, regex-pcre-builtin >= 0.95.2 && < 0.96, - regex-tdfa >= 1.3.2 && < 1.4, + -- regex-tdfa >= 1.3.2 && < 1.4, servant >= 0.20.2 && < 0.21, servant-openapi3 >= 2.0.1 && < 2.1, servant-server >= 0.20.2 && < 0.21, @@ -157,7 +157,6 @@ executable Hastructure-exe attoparsec-aeson, generic-lens, http-types, - ieee754, lens, parallel, math-functions, @@ -165,7 +164,6 @@ executable Hastructure-exe numeric-limits, openapi3, regex-pcre-builtin, - regex-tdfa, servant, servant-openapi3, servant-server, @@ -216,7 +214,7 @@ test-suite Hastructure-test build-depends: Hastructure, Decimal, - base >= 4.18.0 && < 4.20, + base >= 4.18.0 && < 4.21, deepseq, MissingH, containers, @@ -238,7 +236,6 @@ test-suite Hastructure-test attoparsec-aeson, generic-lens, http-types, - ieee754, lens, parallel, math-functions, @@ -246,7 +243,6 @@ test-suite Hastructure-test numeric-limits, openapi3, regex-pcre-builtin, - regex-tdfa, servant, servant-openapi3, servant-server, diff --git a/src/Deal.hs b/src/Deal.hs index 4c039e3f..10e19e52 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -62,7 +62,7 @@ import Data.Time.Clock import Data.Maybe import Data.Either import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty +-- import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 975029e1..987f01e3 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -55,7 +55,7 @@ import Data.Time.Clock import Data.Maybe import Data.Either import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty +-- import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index f804b40f..41eb75c6 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -48,7 +48,6 @@ import Data.Fixed import Data.Maybe import Data.Ratio import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types diff --git a/src/Deal/DealMod.hs b/src/Deal/DealMod.hs index 621ed47c..afbec6c5 100644 --- a/src/Deal/DealMod.hs +++ b/src/Deal/DealMod.hs @@ -48,7 +48,7 @@ import Data.Fixed import Data.Maybe import Data.Ratio import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty +-- import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types @@ -105,4 +105,4 @@ $(deriveJSON defaultOptions ''AdjStrategy) instance ToSchema AdjStrategy $(deriveJSON defaultOptions ''ModifyType) -instance ToSchema ModifyType \ No newline at end of file +instance ToSchema ModifyType diff --git a/src/Lib.hs b/src/Lib.hs index fad28acd..051cee78 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -27,7 +27,7 @@ import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types import Data.Aeson hiding (json) -import Text.Regex.TDFA +-- import Text.Regex.TDFA import Data.Fixed (Fixed(..), HasResolution,Centi, resolution) import Data.Ratio import Types @@ -240,4 +240,4 @@ nextDate d p Quarterly -> 3 SemiAnnually -> 6 Annually -> 12 - _ -> 0 \ No newline at end of file + _ -> 0 From 118c3ad992187c92cbab282acf4cd40ba1b3cd34 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 14 Jul 2025 15:43:59 +0800 Subject: [PATCH 47/49] bump version to-> < 0.50.1 > --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 71378414..d3b40c73 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -104,7 +104,7 @@ debug = flip Debug.Trace.trace version1 :: Version -version1 = Version "0.50.0" +version1 = Version "0.50.1" wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp From a742244556d73eb6a36a0be7525e11bc63a9bbea Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 14 Jul 2025 16:12:02 +0800 Subject: [PATCH 48/49] bump version to-> < 0.50.1 > --- Hastructure.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index 93cbee50..c2685cb0 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -1,11 +1,11 @@ -cabal-version: 3.0 +cabal-version: 0.50.1 -- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: Hastructure -version: 0.50.0 +version: 0.50.1 synopsis: Cashflow modeling library for structured finance description: Please see the README on GitHub at category: StructuredFinance,Securitisation,Cashflow From 26082c9e9588ce5eeb94f5a1ece0603ef296b60f Mon Sep 17 00:00:00 2001 From: yellowbean Date: Mon, 14 Jul 2025 16:21:53 +0800 Subject: [PATCH 49/49] bump version to-> < 0.50.1 > --- Hastructure.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Hastructure.cabal b/Hastructure.cabal index c2685cb0..e01c18b3 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -1,4 +1,4 @@ -cabal-version: 0.50.1 +cabal-version: 3.0 -- This file has been generated from package.yaml by hpack version 0.37.0. --