diff --git a/src/Deal.hs b/src/Deal.hs index 1480f21..d738cd4 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -403,27 +403,27 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= 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) + collectedFlow = Map.map fst 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 -- deposit cashflow to SPV from external pool cf in do - let accs = depositPoolFlow (collects t) d collectedFlow accMap `debug` ("PoolCollection: deposit >>"++ show d++">>>"++ show collectedFlow++"\n") + let 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) -- 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 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)) + 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)) let eopActionsLog = [ RunningWaterfall d W.EndOfPoolCollection | Map.member W.EndOfPoolCollection waterfallM ] -- `debug` ("new logs from trigger 1"++ show newLogs0) let waterfallToExe = Map.findWithDefault [] W.EndOfPoolCollection (waterfall t) -- `debug` ("new logs from trigger 1"++ show newLogs0) (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) - (dRunWithTrigger1,rc3,ads3,newLogs1) <- runTriggers (dAfterAction,rc2,ads2) d EndCollectionWF `debug` ("PoolCollection: Pt 04"++ show d++">> context flow"++show (runPoolFlow rc2))-- `debug` ("End collection action"++ show waterfallToExe) - run dRunWithTrigger1 (runPoolFlow rc3) (Just ads3) rates calls rAssump (newLogs0++newLogs++ eopActionsLog ++newLogs1) `debug` ("PoolCollection: Pt 05>> "++ show d++">> context flow>> "++show (runPoolFlow rc3)) + (dRunWithTrigger1,rc3,ads3,newLogs1) <- runTriggers (dAfterAction,rc2,ads2) d EndCollectionWF -- `debug` ("PoolCollection: Pt 04"++ show d++">> context flow"++show (runPoolFlow rc2))-- `debug` ("End collection action"++ show waterfallToExe) + run dRunWithTrigger1 (runPoolFlow rc3) (Just ads3) rates calls rAssump (newLogs0++newLogs++ eopActionsLog ++newLogs1) -- `debug` ("PoolCollection: Pt 05>> "++ show d++">> context flow>> "++show (runPoolFlow rc3)) else - run t poolFlowMap (Just ads) rates calls rAssump log `debug` ("PoolCollection: hit zero pool length"++ show d++"pool"++ (show poolFlowMap)++"collected cf"++ show pt) + run t poolFlowMap (Just ads) rates calls rAssump log -- `debug` ("PoolCollection: hit zero pool length"++ show d++"pool"++ (show poolFlowMap)++"collected cf"++ show pt) RunWaterfall d _ -> let @@ -452,8 +452,8 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= return (prepareDeal dealAfterCleanUp, endingLogs ++ logsBeforeDist ++newStLogs++[EndRun (Just d) "Clean Up"]) -- `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)) - (dRunWithTrigger1, rc3, ads2, newLogs2) <- runTriggers (dAfterWaterfall,rc2,ads1) d EndDistributionWF `debug` ("In RunWaterfall Date"++show d++"after run waterfall >>"++ show (runPoolFlow rc2)++" collected >>"++ show (pool dAfterWaterfall)) + (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)) + (dRunWithTrigger1, rc3, ads2, newLogs2) <- runTriggers (dAfterWaterfall,rc2,ads1) d EndDistributionWF -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall >>"++ show (runPoolFlow rc2)++" collected >>"++ show (pool dAfterWaterfall)) run dRunWithTrigger1 (runPoolFlow rc3) (Just ads2) rates calls rAssump (newLogsWaterfall++newLogs2++logsBeforeDist++[RunningWaterfall d waterfallKey]) -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall 3>>"++ show (pool dRunWithTrigger1)++" status>>"++ show (status dRunWithTrigger1)) EarnAccInt d accName -> diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index cfb2b11..e56fb96 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -586,9 +586,9 @@ performActionWrap d (StaticAsset _) -> min availBal valuationOnAvailableAssets -- `debug` ("Valuation on rpool"++show valuationOnAvailableAssets) ConstantAsset _ -> availBal AssetCurve _ -> min availBal valuationOnAvailableAssets - let purchaseRatio = divideBB purchaseAmt valuationOnAvailableAssets `debug` ("In Buy >>> Date"++ show d ++ " Purchase Amt"++show purchaseAmt++">> avail value on availAsset"++ show valuationOnAvailableAssets ) - let (assetBought,poolAfterBought) = buyRevolvingPool d (toRational purchaseRatio) assetForSale `debug` ("In Buy >>> date "++ show d ++ "purchase ratio"++ show purchaseRatio) - let boughtAssetBal = sum $ curBal <$> assetBought `debug` ("In Buy >>> Asset bought 0 \n"++ show assetBought++ "pflow map\n"++ show pFlowMap++" p id to change\n"++ show pIdToChange) + let purchaseRatio = divideBB purchaseAmt valuationOnAvailableAssets -- `debug` ("In Buy >>> Date"++ show d ++ " Purchase Amt"++show purchaseAmt++">> avail value on availAsset"++ show valuationOnAvailableAssets ) + let (assetBought,poolAfterBought) = buyRevolvingPool d (toRational purchaseRatio) assetForSale -- `debug` ("In Buy >>> date "++ show d ++ "purchase ratio"++ show purchaseRatio) + let boughtAssetBal = sum $ curBal <$> assetBought -- `debug` ("In Buy >>> Asset bought 0 \n"++ show assetBought++ "pflow map\n"++ show pFlowMap++" p id to change\n"++ show pIdToChange) -- update runtime balance let newPt = case pt of MultiPool pm -> MultiPool $ Map.adjust @@ -599,11 +599,11 @@ performActionWrap d 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 cfBought = fst cfFrameBought -- `debug` ("In Buy>>>"++ show d ++"Cf bought"++ show (fst cfFrameBought)) let newPcf = Map.adjust (\cfOrigin@(CF.CashFlowFrame st trs) -> 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) + boughtCfDates = getDate <$> view CF.cashflowTxn cfBought -- `debug` ("In Buy>>>"++"Date"++ show d++ "Cf bought 0\n"++ show cfBought) newAggDates = case (dsInterval,boughtCfDates) of ([],[]) -> [] @@ -621,11 +621,11 @@ performActionWrap d mergedCf = CF.mergePoolCf2 cfOrigin cfBought -- `debug` ("Buy Date : "++show d ++ "CF bought \n"++ show (over CF.cashflowTxn (slice 0 30) 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 )-- `debug` ("In Buy>>>"++"Date "++show d++" Merged CF\n"++ show mergedCf)) pIdToChange pFlowMap -- `debug` ("pid To change"++ show pIdToChange++ "P flow map"++ show pFlowMap) - let newRc = rc {runPoolFlow = newPcf `debug` ("In Buy>>>"++show d ++ "New run pool >> \n"++ show newPcf) + let newRc = rc {runPoolFlow = newPcf -- `debug` ("In Buy>>>"++show d ++ "New run pool >> \n"++ show newPcf) ,revolvingAssump = Just (Map.insert revolvingPoolName (poolAfterBought, perfAssumps) rMap)} return (t { accounts = newAccMap , pool = newPt}, newRc, logs)