Hastructure 0.50.2 → 0.50.3

raw patch · 25 files changed

+1761/−1759 lines, 25 filesdep −exceptionsdep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: exceptions

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• Hastructure.cabal +4/−4
• app/Main.hs +11/−19
• app/MainBase.hs +2/−2
• src/Asset.hs +2/−2
• src/AssetClass/Installment.hs +6/−7
• src/Assumptions.hs +86/−6
• src/Cashflow.hs +8/−1
• src/Deal.hs +634/−1595
• src/Deal/DealAction.hs +8/−12
• src/Deal/DealBase.hs +10/−63
• src/Deal/DealCollection.hs +89/−0
• src/Deal/DealRun.hs +745/−0
• src/Deal/DealValidation.hs +11/−9
• src/Pool.hs +114/−0
• src/Stmt.hs +0/−1
• src/Triggers.hs +3/−5
• src/Waterfall.hs +2/−7
• test/DealTest/DealTest.hs +3/−3
• test/DealTest/MultiPoolDealTest.hs +3/−3
• test/DealTest/ResecDealTest.hs +6/−5
• test/DealTest/RevolvingTest.hs +5/−8
• test/UT/AssetTest.hs +2/−2
• test/UT/DealTest.hs +4/−3
• test/UT/DealTest2.hs +2/−1
• test/UT/RateHedgeTest.hs +1/−1

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           Hastructure-version: 0.50.2+version: 0.50.3 synopsis:       Cashflow modeling library for structured finance description:    Please see the README on GitHub at <https://github.com/yellowbean/Hastructure#readme> category:       StructuredFinance,Securitisation,Cashflow@@ -52,6 +52,8 @@       Deal.DealMod       Deal.DealQuery       Deal.DealValidation+      Deal.DealRun+      Deal.DealCollection       Errors       Expense       Hedge@@ -84,7 +86,7 @@     bytestring >= 0.12.1 && < 0.13,     -- exceptions >= 0.10.7 && < 0.11,     mtl >= 2.3.1 && < 2.4,-    time >= 1.12.2 && < 1.13,+    time >= 1.12.2 && < 1.15,     text >= 2.1.1 && < 2.2,     regex-base >= 0.94.0 && < 0.95,     aeson >= 2.2.3 && < 2.3,@@ -141,7 +143,6 @@     containers,     template-haskell,     bytestring,-    exceptions,     mtl,     time,     text,@@ -220,7 +221,6 @@     containers,     template-haskell,     bytestring,-    exceptions,     mtl,     time,     text,

@@ -1,13 +1,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE AllowAmbiguousTypes #-}@@ -18,7 +15,6 @@ import Prelude () import Prelude.Compat import System.Environment-import Control.Monad.Catch       (MonadCatch, MonadThrow (..)) import Control.Monad.IO.Class    (liftIO) import Control.Monad (mapM) import Control.Exception (Exception,throwIO,throw)@@ -141,7 +137,6 @@       (_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  patchCumulativeToPoolRun :: RunPoolTypeRtn_ -> RunPoolTypeRtn_ patchCumulativeToPoolRun@@ -158,22 +153,21 @@ 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+      cfs <- traverse (\a -> MA.calcAssetUnion a d mRates) assets       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+      cfs <- traverse (\a -> MA.projAssetUnion a d assumps mRates) assets       return (fst (P.aggPool Nothing [(cf,Map.empty) | (cf,_) <- cfs])  , Nothing)  wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates (Just pm))    = do -      cfs <- sequenceA $ (\a -> MA.projAssetUnion a d assumps mRates) <$> assets-      pricingResult <- sequenceA $ (\a -> D.priceAssetUnion a d pm assumps mRates) <$> assets+      cfs <- traverse (\a -> MA.projAssetUnion a d assumps mRates)  assets+      pricingResult <- traverse (\a -> D.priceAssetUnion a d pm assumps mRates) assets       let (assetCf,_) = P.aggPool Nothing cfs       return (assetCf , Just pricingResult) @@ -213,12 +207,11 @@ runPool :: RunPoolReq -> Handler PoolRunResp runPool (SingleRunPoolReq f pt passumption mRates)    = return $-      patchCumulativeToPoolRun <$> (wrapRunPoolType f pt passumption mRates)+      patchCumulativeToPoolRun <$> wrapRunPoolType f pt passumption mRates  runPoolScenarios :: RunPoolReq -> Handler (Map.Map ScenarioName PoolRunResp) runPoolScenarios (MultiScenarioRunPoolReq f pt mAssumps mRates) -  = return $ Map.map (\assump -> -                        patchCumulativeToPoolRun <$> (wrapRunPoolType f pt (Just assump) mRates)) +  = return $ Map.map (\assump -> patchCumulativeToPoolRun <$> wrapRunPoolType f pt (Just assump) mRates)                        mAssumps  runDeal :: RunDealReq -> Handler RunResp@@ -407,7 +400,7 @@                 Just (EndRun (Just d) _ ) -> d                 Nothing -> case queryClosingDate dt of                              Right d' -> d'-			     Left err -> error $ "Error in BalanceFormula: " ++ err+                             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@@ -433,13 +426,12 @@         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)-		      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)+                      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)       in         case riddersFn (rootFindAlgo req tweak stop) of-          Root r -> Right $ RFResult r (doTweak r tweak req)+          Root r -> return $ RFResult r (doTweak r tweak req)           NotBracketed -> Left "Not able to bracket the root"           SearchFailed -> Left "Not able to find the root" 

@@ -24,7 +24,6 @@ import Prelude () import Prelude.Compat import System.Environment-import Control.Monad.Catch       (MonadCatch, MonadThrow (..)) import Control.Monad.IO.Class    (liftIO) import Control.Monad (mapM) import Control.Exception (Exception,throwIO,throw)@@ -65,6 +64,7 @@ import Types import qualified Deal as D import qualified Deal.DealBase as DB+import qualified Deal.DealCollection as DC import qualified Deal.DealQuery as Q import qualified Asset as Ast import qualified Pool as P@@ -254,7 +254,7 @@ instance ToSchema W.ExtraSupport instance ToSchema W.Action instance ToSchema W.BookType-instance ToSchema W.CollectionRule+instance ToSchema DC.CollectionRule instance ToSchema C.CallOption instance ToSchema CE.LiqCreditCalc instance ToSchema CE.LiqFacility

@@ -198,7 +198,7 @@           vectorUsed = take remainingTerm $ drop agedTerm ppyVectorInCPR         in            case period (getOriginInfo a) of-            Monthly -> Right $ cpr2smm <$> vectorUsed+            Monthly -> return $ cpr2smm <$> vectorUsed             _ -> Left $ "PSA is only supported for monthly payment but got "++ show (period (getOriginInfo a))       Just (A.PrepaymentByTerm rs) ->          let @@ -206,7 +206,7 @@           oTerm = originTerm (getOriginInfo a)         in            case find (\x -> oTerm == length x) rs of -            Just v -> Right $ drop agedTerm v+            Just v -> return $ drop agedTerm v             Nothing -> Left "Prepayment by term doesn't match the origin term"        _ -> Left ("failed to find prepayment type"++ show mPa)

@@ -76,7 +76,7 @@  instance Asset Installment where   calcCashflow inst@(Installment (LoanOriginalInfo ob or ot p sd ptype _) cb rt st) asOfDay _-    = Right $ CF.CashFlowFrame (begBal,asOfDay,Nothing) flows +    = return $ CF.CashFlowFrame (begBal,asOfDay,Nothing) flows       where          lastPayDate:cf_dates = lastN (rt+1) $ sd:getPaymentDates inst 0         opmt = divideBI ob ot  @@ -94,7 +94,6 @@         int_flow =  case ptype of                        F_P -> replicate rt cfee                       PO_FirstN n -> lastN rt $ replicate n 0.0 ++ replicate (ot-n) cfee -        -- initRow = CF.LoanFlow lastPayDate cb 0.0 0.0 0.0 0.0 0.0 0.0 0.0 Nothing         _flows = let                    _rt = succ rt                   in @@ -155,12 +154,12 @@             let (txns,_,_) = projectInstallmentFlow (cb,lastPayDate,(opmt,ofee),orate,currentFactor,pt,ot) (cfDates,defRates,ppyRates,remainTerms)              let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery (DL.toList txns) recoveryAssump)             let begBal = CF.buildBegBal futureTxns-            return $ (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM)+            return (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM)    -- ^ project with defaulted at a date   projCashflow inst@(Installment (LoanOriginalInfo ob or ot p sd ptype _) cb rt (Defaulted (Just defaultedDate)))                 asOfDay -               (_,_,(A.DefaultedRecovery rr lag timing))+               (_,_,A.DefaultedRecovery rr lag timing)                mRates     = let           (cf_dates1,cf_dates2) = splitAt lag $ genDates defaultedDate p (lag+length timing)@@ -171,14 +170,14 @@          futureTxns = cutBy Inc Future asOfDay $ beforeRecoveryTxn++_txns          begBal = CF.buildBegBal futureTxns       in -         Right $ (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns ,Map.empty)+         return (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns ,Map.empty)       where          cr = getOriginRate inst      -- ^ project cashflow with defaulted status   projCashflow inst@(Installment _ cb rt (Defaulted Nothing)) asOfDay assumps _-    = Right $ (CF.CashFlowFrame (cb, asOfDay, Nothing) $ [CF.LoanFlow asOfDay cb 0 0 0 0 0 0 (getOriginRate inst) Nothing],Map.empty)-        +    = return (CF.CashFlowFrame (cb, asOfDay, Nothing) $ [CF.LoanFlow asOfDay cb 0 0 0 0 0 0 (getOriginRate inst) Nothing],Map.empty)+   projCashflow a b c d = Left $ "Failed to match when proj mortgage with assumption >>" ++ show a ++ show b ++ show c ++ show d      splitWith (Installment (LoanOriginalInfo ob or ot p sd _type _obligor) cb rt st) rs

@@ -22,12 +22,14 @@                     ,_ReceivableAssump,_FixedAssetAssump                       ,stressDefaultAssump,applyAssumptionTypeAssetPerf,TradeType(..)                     ,LeaseEndType(..),LeaseDefaultType(..),stressPrepaymentAssump,StopBy(..)+                    ,readCallOptions+                    ,evalFloaterRate,applyFloatRate ,applyFloatRate2                     ) where  import Call as C import Lib (Ts(..),TsPoint(..),toDate,mkRateTs)-import Liability (Bond,InterestInfo)+import Liability (Bond,InterestInfo(..)) import Util import DateUtil import qualified Data.Map as Map @@ -45,7 +47,7 @@ import GHC.Generics import AssetClass.AssetBase import Debug.Trace-import InterestRate+import qualified InterestRate as IR import Control.Lens hiding (Index)   debug = flip trace@@ -311,11 +313,11 @@          assumps  -- | project rates used by rate type ,with interest rate assumptions and observation dates-projRates :: IRate -> RateType -> Maybe [RateAssumption] -> [Date] -> Either String [IRate]+projRates :: IRate ->IR.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 +projRates sr (IR.Fix _ r) _ ds = Right $ replicate (length ds) sr +projRates sr (IR.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 (IR.Floater _ idx spd r dp rfloor rcap mr) (Just assumps) ds    = case getRateAssumption assumps idx of       Nothing -> Left ("Failed to find index rate " ++ show idx ++ " from "++ show assumps)       Just _rateAssumption -> @@ -337,6 +339,84 @@               (Nothing, Just cv) -> capWith cv $ fromRational <$> ratesUsedByDates   projRates _ rt rassump ds = Left ("Invalid rate type: "++ show rt++" assump: "++ show rassump)++-- ^ split call option assumption , +-- lefts are for waterfall payment days+-- rights are for date-based calls+splitCallOpts :: CallOpt -> ([Pre],[Pre])+splitCallOpts (CallPredicate ps) = (ps,[])+splitCallOpts (LegacyOpts copts) = +    let +      cFn (C.PoolBalance bal) = If L (CurrentPoolBalance Nothing) bal+      cFn (C.BondBalance bal) = If L CurrentBondBalance bal+      cFn (C.PoolFactor r) = IfRate L (Types.PoolFactor Nothing) (fromRational r)+      cFn (C.BondFactor r) = IfRate L Types.BondFactor (fromRational r)+      cFn (C.OnDate d) = IfDate E d+      cFn (C.AfterDate d) = IfDate G d+      cFn (C.And _opts) = Types.All [ cFn o | o <- _opts  ]+      cFn (C.Or _opts) = Types.Any [ cFn o | o <- _opts  ]+      cFn (C.Pre p) = p+    in +      ([ cFn copt | copt <- copts ],[])+-- legacyCallOptConvert (AP.CallOptions opts) = concat [ legacyCallOptConvert o | o <- opts ]+splitCallOpts (CallOnDates dp ps) = ([],ps)+++readCallOptions :: [CallOpt] -> ([Pre],[Pre])+readCallOptions [] = ([],[])+readCallOptions opts = +  let +    result = splitCallOpts <$> opts+  in +    (concat (fst <$> result), concat (snd <$> result))++evalFloaterRate :: Date -> [RateAssumption] -> IR.RateType -> IRate +evalFloaterRate _ _ (IR.Fix _ r) = r +evalFloaterRate d ras (IR.Floater _ idx spd _r _ mFloor mCap mRounding)+  = let +      ra = getRateAssumption ras idx +      flooring (Just f) v = max f v +      flooring Nothing v = v +      capping (Just f) v = min f v +      capping Nothing  v = v +    in +      case ra of +        Nothing -> error "Failed to find index rate in assumption"+        Just (RateFlat _ v) -> capping mCap $ flooring mFloor $ v + spd +        Just (RateCurve _ curve) -> capping mCap $ flooring mFloor $ fromRational $ getValByDate curve Inc d + toRational spd++applyFloatRate :: InterestInfo -> Date -> [RateAssumption] -> IRate+applyFloatRate (Liability.Floater _ idx spd p dc mf mc) d ras+  = case (mf,mc) of+      (Nothing,Nothing) -> _rate+      (Just f,Nothing) -> max f _rate+      (Just f,Just c) -> min c $ max f _rate+      (Nothing,Just c) -> min c _rate+    where+      idx_rate = case ra of +        Just (RateCurve _idx _ts) -> fromRational $ getValByDate _ts Exc d+        Just (RateFlat _idx _r) ->   _r+        Nothing -> 0.0+      ra = getRateAssumption ras idx+      _rate = idx_rate + spd -- `debug` ("idx"++show idx_rate++"spd"++show spd)++applyFloatRate (Liability.CapRate ii _rate) d ras = min _rate (applyFloatRate ii d ras)+applyFloatRate (Liability.FloorRate ii _rate) d ras = max _rate (applyFloatRate ii d ras)+applyFloatRate (Liability.Fix r _ ) d ras = r+applyFloatRate (Liability.WithIoI ii _) d ras = applyFloatRate ii d ras++applyFloatRate2 :: IR.RateType -> Date -> [RateAssumption] -> Either String IRate+applyFloatRate2 (IR.Fix _ r) _ _ = Right r+applyFloatRate2 (IR.Floater _ idx spd _r _ mFloor mCap mRounding) d ras+  = let +      flooring (Just f) v = max f v +      flooring Nothing v = v +      capping (Just f) v = min f v +      capping Nothing  v = v +    in +      do +        rateAtDate <- lookupRate0 ras idx d +        return $ flooring mFloor $ capping mCap $ rateAtDate + spd   -- ^ Given a list of rates, calcualte whether rates was reset

@@ -28,7 +28,7 @@                 ,splitPoolCashflowByDate                 ,getAllDatesCashFlowFrame,splitCf, cutoffCashflow                 ,AssetCashflow,PoolCashflow-                ,emptyCashflow,isEmptyRow2+                ,emptyCashflow,isEmptyRow2,appendMCashFlow                 ) where  import Data.Time (Day)@@ -1155,6 +1155,13 @@     getter (CashFlowFrame _ txns) = txns     setter (CashFlowFrame st txns) newTxns = CashFlowFrame st newTxns +appendMCashFlow :: Maybe CashFlowFrame -> [TsRow] -> Maybe CashFlowFrame+appendMCashFlow Nothing [] = Nothing+appendMCashFlow (Just cf) [] = Just cf+appendMCashFlow Nothing txns +  = Just $ CashFlowFrame (0, epocDate, Nothing) txns+appendMCashFlow (Just (CashFlowFrame st txns)) newTxns +  = Just $ CashFlowFrame st (txns ++ newTxns)  txnCumulativeStats :: Lens' TsRow (Maybe CumulativeStat) txnCumulativeStats = lens getter setter

@@ -7,1600 +7,639 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} -module Deal (run,runPool,getInits,runDeal,ExpectReturn(..)-            ,performAction-            ,populateDealDates,accrueRC-            ,calcTargetAmount,updateLiqProvider-            ,projAssetUnion,priceAssetUnion-            ,removePoolCf,runPoolType,PoolType-            ,ActionOnDate(..),DateDesp(..)-            ,changeDealStatus-            ) where--import Control.Parallel.Strategies-import qualified Accounts as A-import qualified Ledger as LD-import qualified Asset as Ast-import qualified Pool as P-import qualified Expense as F-import qualified Liability as L-import qualified CreditEnhancement as CE-import qualified Analytics-import qualified Waterfall as W-import qualified Cashflow as CF-import qualified Assumptions as AP-import qualified Reports as Rpt-import qualified AssetClass.AssetBase as ACM-import AssetClass.Mortgage-import AssetClass.Lease-import AssetClass.Loan-import AssetClass.Installment-import AssetClass.MixedAsset--import qualified Call as C-import qualified InterestRate as IR-import Deal.DealBase-import Deal.DealQuery-import Deal.DealAction-import qualified Deal.DealValidation as V-import Stmt-import Lib-import Util-import DateUtil-import Types-import Revolving-import Triggers--import qualified Data.Map as Map hiding (mapEither)-import qualified Data.Time as T-import qualified Data.Set as S-import qualified Control.Lens as LS-import Data.List-import qualified Data.DList as DL-import Data.Fixed-import Data.Time.Clock-import Data.Maybe-import Data.Either-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-import GHC.Generics-import Control.Monad-import Control.Monad.Writer-import Control.Monad.Loops (allM,anyM)-import Control.Applicative (liftA2)--import Debug.Trace-import Cashflow (buildBegTsRow)-import Assumptions (NonPerfAssumption(NonPerfAssumption),lookupRate0)-import Asset ()-import Pool (issuanceStat)-import qualified Types as P-import Control.Lens hiding (element)-import Control.Lens.TH-import Data.Either.Utils-import InterestRate (calcInt)-import Liability (getDayCountFromInfo,getTxnRate)-import Hedge (RateCap(..),RateSwapBase(..),RateSwap(rsRefBalance))-import qualified Hedge as HE--debug = flip trace---- ^ update bond interest rate from rate assumption-setBondNewRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond-setBondNewRate t d ras b@(L.Bond _ _ L.OriginalInfo{ L.originDate = od} ii _ bal currentRate _ dueInt _ Nothing _ _ _)-  = setBondNewRate t d ras b {L.bndDueIntDate = Just od}---- ^ Floater rate-setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Floater br idx _spd rset dc mf mc) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _)-  = Right $ (L.accrueInt d b){ L.bndRate = applyFloatRate ii d ras }---- ^ Fix rate, do nothing-setBondNewRate t d ras b@(L.Bond _ _ _ L.Fix {} _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _)-  = Right b---- ^ Ref rate-setBondNewRate t d ras b@(L.Bond _ _ _ (L.RefRate sr ds factor _) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) -  = do-      let b' = L.accrueInt d b-      rate <- queryCompound t d (patchDateToStats d ds)-      return b' {L.bndRate = fromRational (rate * toRational factor) }---- ^ cap & floor & IoI-setBondNewRate t d ras b@(L.Bond _ _ _ ii _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) -  = Right $ (L.accrueInt d b) { L.bndRate = applyFloatRate ii d ras}---- ^ bond group-setBondNewRate t d ras bg@(L.BondGroup bMap pt)-  = do -      m <- mapM (setBondNewRate t d ras) bMap-      return $ L.BondGroup m pt---- ^ apply all rates for multi-int bond-setBondNewRate t d ras b@(L.MultiIntBond bn _ _ iis _ bal currentRates _ dueInts dueIoIs _ _ _ _)-  = let -      newRates = applyFloatRate <$> iis <*> pure d <*> pure ras-      b' = L.accrueInt d b -- `debug` ("accrue due to new rate "++ bn)-    in-      Right $ b' { L.bndRates = newRates } ----setBondStepUpRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond-setBondStepUpRate t d ras b@(L.Bond _ _ _ ii (Just sp) _ _ _ _ _ _ _ _ _)-  = Right $ -      let -        newII = L.stepUpInterestInfo sp ii-        newRate = applyFloatRate ii d ras-      in -        (L.accrueInt d b) { L.bndInterestInfo = newII, L.bndRate = newRate }--setBondStepUpRate t d ras b@(L.MultiIntBond bn _ _ iis (Just sps) _ _ _ _ _ _ _ _ _)-  = Right $ -      let -        newIIs = zipWith L.stepUpInterestInfo sps iis-        newRates = (\x -> applyFloatRate x d ras) <$> newIIs-      in -        (L.accrueInt d b) { L.bndInterestInfos = newIIs, L.bndRates = newRates }  -- `debug` (show d ++ ">> accure due to step up rate "++ bn)--setBondStepUpRate t d ras bg@(L.BondGroup bMap pt)-  = do -      m <- mapM (setBondStepUpRate t d ras) bMap-      return $ L.BondGroup m pt----updateSrtRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> HE.SRT -> Either String HE.SRT-updateSrtRate t d ras srt@HE.SRT{HE.srtPremiumType = rt} -    = do -        r <- applyFloatRate2 rt d ras -        return srt { HE.srtPremiumRate = r }---accrueSrt :: Ast.Asset a => TestDeal a -> Date -> HE.SRT -> Either String HE.SRT-accrueSrt t d srt@HE.SRT{ HE.srtDuePremium = duePrem, HE.srtRefBalance = bal, HE.srtPremiumRate = rate-                        , HE.srtDuePremiumDate = mDueDate,  HE.srtType = st-                        , HE.srtStart = sd } -  = do -      newBal <- case st of-                  HE.SrtByEndDay ds dp -> queryCompound t d (patchDateToStats d ds)-      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}---updateLiqProviderRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> CE.LiqFacility -> CE.LiqFacility-updateLiqProviderRate t d ras liq@CE.LiqFacility{CE.liqRateType = mRt, CE.liqPremiumRateType = mPrt-                                                , CE.liqRate = mr, CE.liqPremiumRate = mPr }-  = let -      newMr =  evalFloaterRate d ras <$> mRt-      newMpr = evalFloaterRate d ras <$> mPrt-      -- TODO probably need to accure int when interest rate changes ? -    in -      liq {CE.liqRate = newMr, CE.liqPremiumRate = newMpr }---evalFloaterRate :: Date -> [RateAssumption] -> IR.RateType -> IRate -evalFloaterRate _ _ (IR.Fix _ r) = r -evalFloaterRate d ras (IR.Floater _ idx spd _r _ mFloor mCap mRounding)-  = let -      ra = AP.getRateAssumption ras idx -      flooring (Just f) v = max f v -      flooring Nothing v = v -      capping (Just f) v = min f v -      capping Nothing  v = v -    in -      case ra of -        Nothing -> error "Failed to find index rate in assumption"-        Just (RateFlat _ v) -> capping mCap $ flooring mFloor $ v + spd -        Just (RateCurve _ curve) -> capping mCap $ flooring mFloor $ fromRational $ getValByDate curve Inc d + toRational spd--applyFloatRate :: L.InterestInfo -> Date -> [RateAssumption] -> IRate-applyFloatRate (L.Floater _ idx spd p dc mf mc) d ras-  = case (mf,mc) of-      (Nothing,Nothing) -> _rate-      (Just f,Nothing) -> max f _rate-      (Just f,Just c) -> min c $ max f _rate-      (Nothing,Just c) -> min c _rate-    where-      idx_rate = case ra of -        Just (RateCurve _idx _ts) -> fromRational $ getValByDate _ts Exc d-        Just (RateFlat _idx _r) ->   _r-        Nothing -> 0.0-      ra = AP.getRateAssumption ras idx-      _rate = idx_rate + spd -- `debug` ("idx"++show idx_rate++"spd"++show spd)--applyFloatRate (L.CapRate ii _rate) d ras = min _rate (applyFloatRate ii d ras)-applyFloatRate (L.FloorRate ii _rate) d ras = max _rate (applyFloatRate ii d ras)-applyFloatRate (L.Fix r _ ) d ras = r-applyFloatRate (L.WithIoI ii _) d ras = applyFloatRate ii d ras--applyFloatRate2 :: IR.RateType -> Date -> [RateAssumption] -> Either String IRate-applyFloatRate2 (IR.Fix _ r) _ _ = Right r-applyFloatRate2 (IR.Floater _ idx spd _r _ mFloor mCap mRounding) d ras-  = let -      flooring (Just f) v = max f v -      flooring Nothing v = v -      capping (Just f) v = min f v -      capping Nothing  v = v -    in -      do -        rateAtDate <- AP.lookupRate0 ras idx d -        return $ flooring mFloor $ capping mCap $ rateAtDate + spd--updateRateSwapRate :: Ast.Asset a => TestDeal a -> Maybe [RateAssumption] -> Date -> HE.RateSwap -> Either String HE.RateSwap-updateRateSwapRate t Nothing _ _ = Left "Failed to update rate swap: No rate input assumption"-updateRateSwapRate t (Just rAssumps) d rs@HE.RateSwap{ HE.rsType = rt } -  = let -      getRate x = AP.lookupRate rAssumps x d-    in-      do  -        (pRate,rRate) <- case rt of -                              HE.FloatingToFloating flter1 flter2 ->-                                do -                                  r1 <- getRate flter1-                                  r2 <- getRate flter2-                                  return (r1, r2)-                              HE.FloatingToFixed flter r -> -                                do -                                  _r <- getRate flter-                                  return (_r, r)-                              HE.FixedToFloating r flter -> -                                do -                                  _r <- getRate flter-                                  return (r, _r)-                              HE.FormulaToFloating ds flter -> -                                do -                                  _r <- queryCompound t d (patchDateToStats d ds)-                                  r <- getRate flter-                                  return (fromRational _r, r)-                              HE.FloatingToFormula flter ds -> -                                do -                                  r <- getRate flter-                                  _r <- queryCompound t d (patchDateToStats d ds)-                                  return (r, fromRational _r)-        return rs {HE.rsPayingRate = pRate, HE.rsReceivingRate = rRate }--updateRateSwapBal :: Ast.Asset a => TestDeal a -> Date -> HE.RateSwap -> Either String HE.RateSwap-updateRateSwapBal t d rs@HE.RateSwap{ HE.rsNotional = base }-  =  case base of -        HE.Fixed _ -> Right rs  -        HE.Schedule ts -> Right $ rs { HE.rsRefBalance = fromRational (getValByDate ts Inc d) }-        HE.Base ds -> -            do -              v <- queryCompound t d (patchDateToStats d ds) -              return rs { HE.rsRefBalance = fromRational v} -- `debug` ("query Result"++ show (patchDateToStats d ds) )---- ^ accure rate cap -accrueRC :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> RateCap -> Either String RateCap-accrueRC t d rs rc@RateCap{rcNetCash = amt, rcStrikeRate = strike,rcIndex = index-                        ,rcStartDate = sd, rcEndDate = ed, rcNotional = notional-                        ,rcLastStlDate = mlsd-                        ,rcStmt = mstmt} -  | d > ed || d < sd = Right rc -  | otherwise = do-                  r <- lookupRate0 rs index d-                  balance <- case notional of-                               Fixed bal -> Right . toRational $ bal-                               Base ds -> queryCompound t d (patchDateToStats d ds)-                               Schedule ts -> Right $ getValByDate ts Inc d--                  let accRate = max 0 $ r - fromRational (getValByDate strike Inc d) -- `debug` ("Rate from curve"++show (getValByDate strike Inc d))-                  let addAmt = case mlsd of -                                 Nothing -> calcInt (fromRational balance) sd d accRate DC_ACT_365F-                                 Just lstD -> calcInt (fromRational balance) lstD d accRate DC_ACT_365F--                  let newAmt = amt + addAmt  -- `debug` ("Accrue AMT"++ show addAmt)-                  let newStmt = appendStmt (IrsTxn d newAmt addAmt 0 0 0 SwapAccrue) mstmt -                  return $ rc { rcLastStlDate = Just d ,rcNetCash = newAmt, rcStmt = newStmt }---- ^ test if a clean up call should be fired-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.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 -       C.AfterDate x -> Right $ d > x-       C.And xs -> allM (testCall t d) xs-       C.Or xs -> anyM (testCall t d) xs-       -- C.And xs -> (all id) <$> sequenceA $ [testCall t d x | x <- xs]-       -- C.Or xs -> (any id) <$> sequenceA $ [testCall t d x | x <- xs]-       C.Pre pre -> testPre d t pre-       _ -> Left ("failed to find call options"++ show opt)---queryTrigger :: Ast.Asset a => TestDeal a -> DealCycle -> [Trigger]-queryTrigger t@TestDeal{ triggers = trgs } wt -  = case trgs of -      Nothing -> []-      Just _trgs -> maybe [] Map.elems $ Map.lookup wt _trgs---- ^ execute effects of trigger: making changes to deal--- TODO seems position of arugments can be changed : f :: a -> b -> m a  => f:: b -> a -> m a-runEffects :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent) -> Date -> TriggerEffect -           -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent)-runEffects (t@TestDeal{accounts = accMap, fees = feeMap ,status=st, bonds = bondMap, pool=pt-                      ,collects = collRules}, rc, actions, logs) d te-  = case te of -      DealStatusTo _ds -> Right (t {status = _ds}, rc, actions, logs)-      DoAccrueFee fns -> do-                           newFeeList <- sequenceA $ calcDueFee t d  <$> (feeMap Map.!) <$> fns-                           let newFeeMap = Map.fromList (zip fns newFeeList) <> feeMap-                           return (t {fees = newFeeMap}, rc, actions, logs)-      ChangeReserveBalance accName rAmt ->-          Right (t {accounts = Map.adjust (set A.accTypeLens (Just rAmt)) accName accMap }-                    , rc, actions, logs)-      -      TriggerEffects efs -> foldM (`runEffects` d) (t, rc, actions, logs) efs-      -      RunActions wActions -> do-                              (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---- ^ test triggers in the deal and add a log if deal status changed-runTriggers :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate]) -> Date -> DealCycle -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent)-runTriggers (t@TestDeal{status=oldStatus, triggers = Nothing},rc, actions) d dcycle = Right (t, rc, actions, DL.empty)-runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc, actions) d dcycle = -  do-    let trgsMap = Map.findWithDefault Map.empty dcycle trgM-    let trgsToTest = Map.filter   -                           (\trg -> (not (trgStatus trg) || trgStatus trg && trgCurable trg))-                           trgsMap-    triggeredTrgs <- mapM (testTrigger t d) trgsToTest-    let triggeredEffects = [ trgEffects _trg | _trg <- Map.elems triggeredTrgs, (trgStatus _trg) ] -    (newDeal, newRc, newActions, logsFromTrigger) <- foldM (`runEffects` d) (t,rc,actions, DL.empty) triggeredEffects-    let newStatus = status newDeal -    let newLogs = DL.fromList [DealStatusChangeTo d oldStatus newStatus "By trigger"|  newStatus /= oldStatus] -- `debug` (">>"++show d++"trigger : new st"++ show newStatus++"old st"++show oldStatus)-    let newTriggers = Map.union triggeredTrgs trgsMap-    return (newDeal {triggers = Just (Map.insert dcycle newTriggers trgM)}-           , newRc-           , newActions-           , DL.append newLogs logsFromTrigger) -- `debug` ("New logs from trigger"++ show d ++">>>"++show newLogs)---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 (d,why) newSt t@TestDeal{status=oldSt} = (Just (DealStatusChangeTo d oldSt newSt why), t {status=newSt})----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 endedDate)} pCfM ads _ _ _ log  = return (t,DL.snoc log (EndRun 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-  | 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 -        return (finalDeal-                , DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving")-                , poolFlowMap)--  | otherwise-    = case ad of -        PoolCollection d _ ->-          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 -              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  -              -- 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}-                -- newScheduleFlowMap = Map.map (over CF.cashflowTxn (cutBy Exc Future d)) (fromMaybe Map.empty (getScheduledCashflow t Nothing))-                let newPt = case (pool dAfterDeposit) of -	  		      MultiPool pm -> MultiPool $-				                Map.map -	                                          (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))-		(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)-                (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 (increasePoolCollectedPeriod dRunWithTrigger1 )-                    (runPoolFlow rc3) -                    (Just ads3) -                    rates -                    calls -                    rAssump -                    (DL.concat [newLogs0,newLogs,eopActionsLog,newLogs1]) -          else-            run t poolFlowMap (Just ads) rates calls rAssump log --        RunWaterfall d "" -> -          let-            runContext = RunContext poolFlowMap rAssump rates-            waterfallKey = if Map.member (W.DistributionDay dStatus) waterfallM then -                              W.DistributionDay dStatus-                            else -                              W.DefaultDistribution-                        -            waterfallToExe = Map.findWithDefault [] waterfallKey waterfallM-            callTest = fst $ fromMaybe ([]::[Pre],[]::[Pre]) calls-          in -            do -              (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) )-              if flag then-                do-                  let newStLogs = if null cleanUpActions then -                                    [DealStatusChangeTo d dStatus Called "Call by triggers before waterfall distribution"]-                                  else -                                    [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], 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))-                  (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 (increaseBondPaidPeriod dRunWithTrigger1)-                      (runPoolFlow rc3) -                      (Just ads2) -                      rates -                      calls -                      rAssump -                      (DL.concat [newLogsWaterfall, newLogs2 ,logsBeforeDist,DL.fromList [RunningWaterfall d waterfallKey]]) -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall 3>>"++ show (pool dRunWithTrigger1)++" status>>"++ show (status dRunWithTrigger1))--        -- Custom waterfall execution action from custom dates-        RunWaterfall d wName -> -          let-            runContext = RunContext poolFlowMap rAssump rates-            waterfallKey = W.CustomWaterfall wName-          in -            do-              waterfallToExe <- maybeToEither-                                  ("No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) $-                                  Map.lookup waterfallKey waterfallM-              let logsBeforeDist =[ WarningMsg (" No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) -                                        | Map.notMember waterfallKey waterfallM ]  -              (dAfterWaterfall, rc2, newLogsWaterfall) <- foldM (performActionWrap d) (t,runContext,log) waterfallToExe -- `debug` (show d ++ " running action"++ show waterfallToExe)-              run dAfterWaterfall (runPoolFlow rc2) (Just ads) rates calls rAssump -                  (DL.concat [newLogsWaterfall,DL.fromList (logsBeforeDist ++ [RunningWaterfall d waterfallKey])]) -- `debug` ("size of logs"++ show (length newLogsWaterfall)++ ">>"++ show d++ show (length logsBeforeDist))--        EarnAccInt d accName ->-          let -            newAcc = Map.adjust (A.depositInt d) accName accMap-          in -            run (t {accounts = newAcc}) poolFlowMap (Just ads) rates calls rAssump log--        AccrueFee d feeName -> -          do -            fToAcc <- maybeToEither -                        ("Failed to find fee "++feeName)-                        (Map.lookup feeName feeMap)-            newF <- calcDueFee t d fToAcc-            let newFeeMap = Map.fromList [(feeName,newF)] <> feeMap-            run (t{fees=newFeeMap}) poolFlowMap (Just ads) rates calls rAssump log--        ResetLiqProvider d liqName -> -          case liqProvider t of -            Nothing -> run t poolFlowMap (Just ads) rates calls rAssump log-            (Just mLiqProvider) -              -> let -- update credit -                   newLiqMap = Map.adjust (updateLiqProvider t d) liqName mLiqProvider-                 in-                   run (t{liqProvider = Just newLiqMap}) poolFlowMap (Just ads) rates calls rAssump log--        ResetLiqProviderRate d liqName -> -          case liqProvider t of -            Nothing -> run t poolFlowMap (Just ads) rates calls rAssump log-            (Just mLiqProvider) -              -> let -- update rate -                   newLiqMap = Map.adjust (updateLiqProviderRate t d (fromMaybe [] rates)) liqName mLiqProvider-                 in-                   run (t{liqProvider = Just newLiqMap}) poolFlowMap (Just ads) rates calls rAssump log-        -        DealClosed d ->-          let-            w = Map.findWithDefault [] W.OnClosingDay (waterfall t) -            rc = RunContext poolFlowMap rAssump rates  -            logForClosed =  [RunningWaterfall d W.OnClosingDay| not (null w)]-          in -            do-              newSt <- case dStatus of-                         (PreClosing st) -> Right st-                         _ -> Left $ "DealClosed action is not in PreClosing status but got"++ show dStatus-              (newDeal, newRc, newLog) <- foldM (performActionWrap d) (t, rc, log) w  -- `debug` ("ClosingDay Action:"++show w)-              run newDeal{status=newSt} (runPoolFlow newRc) (Just ads) rates calls rAssump -                  (DL.concat [newLog, DL.fromList ([DealStatusChangeTo d (PreClosing newSt) newSt "By Deal Close"]++logForClosed)]) -- `debug` ("new st at closing"++ show newSt)--        ChangeDealStatusTo d s -> run (t{status=s}) poolFlowMap (Just ads) rates calls rAssump log--        CalcIRSwap d sn -> -          case rateSwap t of -            Nothing -> Left $ " No rate swaps modeled when looking for "++ sn-            Just rSwap ->-              do-                newRateSwap_rate <- adjustM (updateRateSwapRate t rates d) sn rSwap-                newRateSwap_bal <- adjustM (updateRateSwapBal t d) sn newRateSwap_rate -                let newRateSwap_acc = Map.adjust (HE.accrueIRS d) sn newRateSwap_bal-                run (t{rateSwap = Just newRateSwap_acc}) poolFlowMap (Just ads) rates calls rAssump log--        SettleIRSwap d sn -> -          case rateSwap t of -            Nothing -> Left $ " No rate swaps modeled when looking for "++ sn-            Just rSwap ->-              do-                acc <- case HE.rsSettleDates (rSwap Map.! sn) of -                          Nothing -> Left $ "No settle date found for "++ sn-                          Just (_, _accName) -> Right $ accMap Map.! _accName-                let accBal = A.accBalance acc-                let rs = rSwap Map.! sn-                let settleAmt = HE.rsNetCash rs-                let accName = A.accName acc-                case (settleAmt <0, accBal < abs settleAmt) of -                  (True, True) ->-                    let-                      newAcc = Map.adjust (A.draw accBal d (SwapOutSettle sn)) accName accMap-                      newRsMap = Just $ Map.adjust (HE.payoutIRS d accBal) sn rSwap -                    in -                      run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump-                      $ DL.snoc log (WarningMsg $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn)-                    -- Left $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn-                  (True, False) -> -                    let-                      newAcc = Map.adjust (A.draw (abs settleAmt) d (SwapOutSettle sn)) accName  accMap-                      newRsMap = Just $ Map.adjust (HE.payoutIRS d settleAmt) sn rSwap -                    in -                      run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log-                  (False, _) -> -                    let -                      newAcc = Map.adjust (A.deposit settleAmt d (SwapInSettle sn)) accName accMap-                      newRsMap = Just $ Map.adjust (HE.receiveIRS d) sn rSwap -                    in-                      run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log--        AccrueCapRate d cn -> -          case rateCap t of -            Nothing -> Left $ " No rate cap found for "++ cn-            Just rCap ->-              let-                _rates = fromMaybe [] rates-              in -                do -                  newRateCap <- adjustM (accrueRC t d _rates) cn rCap-                  run (t{rateCap = Just newRateCap}) poolFlowMap (Just ads) rates calls rAssump log--        InspectDS d dss -> -          do-            newlog <- inspectListVars t d dss -            run t poolFlowMap (Just ads) rates calls rAssump $ DL.append log (DL.fromList newlog) -- `debug` ("Add log"++show newlog)-        -        ResetBondRate d bn  -> -          let -            rateList = fromMaybe [] rates-            bnd = bndMap Map.! bn-          in -            do -              newBnd <- setBondNewRate t d rateList bnd -              run t{bonds = Map.fromList [(bn,newBnd)] <> bndMap} poolFlowMap (Just ads) rates calls rAssump log-        -        StepUpBondRate d bn -> -          let -            bnd = bndMap Map.! bn -- `debug` ("StepUpBondRate--------------"++ show bn)-          in -            do -              -- newBnd <- setBondStepUpRate t d bnd `debug` ("StepUpBondRate"++ show d++ show bn)-              newBndMap <- adjustM (setBondStepUpRate t d (fromMaybe [] rates)) bn bndMap-              run t{bonds = newBndMap } poolFlowMap (Just ads) rates calls rAssump log-        -        ResetAccRate d accName -> -          do-            newAccMap <- adjustM -                          (\a@(A.Account _ _ (Just (A.InvestmentAccount idx spd dp dp1 lastDay _)) _ _)-                            -> do-                                 newRate <- AP.lookupRate (fromMaybe [] rates) (idx,spd) d -                                 let accWithNewInt = A.depositInt d a-                                 return accWithNewInt { A.accInterest = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)})-                          accName accMap-            run t{accounts = newAccMap} poolFlowMap (Just ads) rates calls rAssump log--        BuildReport sd ed ->-          let -            cashReport = Rpt.buildCashReport t sd ed -          in -            do -              bsReport <- Rpt.buildBalanceSheet t ed-              let newlog = FinancialReport sd ed bsReport cashReport-              run t poolFlowMap (Just ads) rates calls rAssump $ DL.snoc log newlog -- `debug` ("new log"++ show ed++ show newlog)--        FireTrigger d cyc n -> -          let -            triggerFired = case mTrgMap of -                               Nothing -> error "trigger is empty for override" -                               Just tm -> Map.adjust (Map.adjust (set trgStatusLens True) n) cyc tm-            triggerEffects = do-                                tm <- mTrgMap-                                cycM <- Map.lookup cyc tm-                                trg <- Map.lookup n cycM-                                return $ trgEffects trg-            -            runContext = RunContext poolFlowMap rAssump rates-          in -            do -              (newT, rc@(RunContext newPool _ _), adsFromTrigger, newLogsFromTrigger) -                <- case triggerEffects of -                    Nothing -> Right (t, runContext, ads, DL.empty) -- `debug` "Nothing found on effects"-                    Just efs -> runEffects (t, runContext, ads, DL.empty) d efs-              let (oldStatus,newStatus) = (status t,status newT)-              let stChangeLogs = DL.fromList [DealStatusChangeTo d oldStatus newStatus "by Manual fireTrigger" |  oldStatus /= newStatus] -              run newT {triggers = Just triggerFired} newPool (Just ads) rates calls rAssump $ DL.concat [log,stChangeLogs,newLogsFromTrigger]-        -        MakeWhole d spd walTbl -> -            let -              schedulePoolFlowMap = case pt of -				      MultiPool pMap -> Map.map (view (P.poolFutureScheduleCf._Just._1) ) 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 (\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 >)))))-                                 bondWal -                let bondPricingCurve = Map.map -                                         (\x -> IRateCurve [ TsPoint d x,TsPoint (getDate (last ads)) x] )-                                         bondSprd -                let bondPricingResult = Map.intersectionWithKey (\k v1 v2 -> L.priceBond d v2 v1) (bonds runDealWithSchedule) bondPricingCurve -                let depositBondFlow = Map.intersectionWith-                                        (\bnd (PriceResult pv _ _ _ _ _ _) -> -                                          let -                                            ostBal = L.getCurBalance bnd-                                            prinToPay = min pv ostBal-                                            intToPay = max 0 (pv - prinToPay)-                                            bnd1 = L.payPrin d prinToPay bnd-                                          in -                                            L.payYield d intToPay bnd1)-                                        (bonds t)-                                        bondPricingResult-                run t {bonds = depositBondFlow, status = Ended (Just d)} Map.empty (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call")-        -        FundBond d Nothing bName accName fundAmt ->-          let -            newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap-          in -            do-              let bndFunded = L.fundWith d fundAmt $ bndMap Map.! bName-              run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap}-                  poolFlowMap (Just ads) rates calls rAssump log--        FundBond d (Just p) bName accName fundAmt ->-          let -            newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap-          in -            do-              flag <- testPre d t p-              case flag of-                False -> run t poolFlowMap (Just ads) rates calls rAssump (DL.snoc log (WarningMsg ("Failed to fund bond"++ bName++ ":" ++show p)))-                True -> -                  do-                    let bndFunded = L.fundWith d fundAmt $ bndMap Map.! bName-                    run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap}-                        poolFlowMap (Just ads) rates calls rAssump log-          --        IssueBond d Nothing bGroupName accName bnd mBal mRate -> -           run t poolFlowMap (Just ((IssueBond d (Just (Always True)) bGroupName accName bnd mBal mRate):ads)) rates calls rAssump log-        -        IssueBond d (Just p) bGroupName accName bnd mBal mRate ->-            do -              flag <- testPre d t p-              case flag of-                False -> run t poolFlowMap (Just ads) rates calls rAssump (DL.snoc log (WarningMsg ("Failed to issue to bond group"++ bGroupName++ ":" ++show p)))-                True -> let -                          newBndName = L.bndName bnd-                        in-                           do-                             newBalance <- case mBal of-                                             Just _q -> queryCompound t d (patchDateToStats d _q)  -                                             Nothing -> Right . toRational $ L.originBalance (L.bndOriginInfo bnd)-                             newRate <- case mRate of -                                         Just _q -> queryCompound t d (patchDateToStats d _q)-                                         Nothing -> Right $ L.originRate (L.bndOriginInfo bnd)-                             let newBonds = case Map.lookup bGroupName bndMap of-                                              Nothing -> bndMap-                                              Just L.Bond {} -> bndMap-                                              Just (L.BondGroup bndGrpMap pt) -> let-                                                                                bndOInfo = (L.bndOriginInfo bnd) {L.originDate = d, L.originRate = newRate, L.originBalance = fromRational newBalance }-                                                                                bndToInsert = bnd {L.bndOriginInfo = bndOInfo,-                                                                                                   L.bndDueIntDate = Just d,-                                                                                                   L.bndLastIntPay = Just d, -                                                                                                   L.bndLastPrinPay = Just d,-                                                                                                   L.bndRate = fromRational newRate,-                                                                                                   L.bndBalance = fromRational newBalance}-                                                                              in -                                                                                Map.insert bGroupName -                                                                                           (L.BondGroup (Map.insert newBndName bndToInsert bndGrpMap) pt)-                                                                                           bndMap--                             let issuanceProceeds = fromRational newBalance-                             let newAcc = Map.adjust (A.deposit issuanceProceeds d (IssuanceProceeds newBndName))-                                                     accName-                                                     accMap-                             run t{bonds = newBonds, accounts = newAcc} poolFlowMap (Just ads) rates calls rAssump log-        RefiBondRate d accName bName iInfo ->-           let-             -- settle accrued interest -             -- TODO rebuild bond rate reset actions-             lstDate = getDate (last ads)-             isResetActionEvent (ResetBondRate _ bName ) = False -             isResetActionEvent _ = True-             filteredAds = filter isResetActionEvent ads-             newRate = L.getBeginRate iInfo-          in -             do -               nBnd <- calcDueInt t d $ bndMap Map.! bName-               let dueIntToPay = L.getTotalDueInt nBnd-               let ((shortfall,drawAmt),newAcc) = A.tryDraw dueIntToPay d (PayInt [bName]) (accMap Map.! accName)-               let newBnd = set L.bndIntLens iInfo $ L.payInt d drawAmt nBnd-               let resetDates = L.buildRateResetDates newBnd d lstDate -               -- let bResetActions = [ ResetBondRate d bName 0 | d <- resetDates ]-               -- TODO tobe fix-               let bResetActions = []-               let newAccMap = Map.insert accName newAcc accMap-               let newBndMap = Map.insert bName (newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d ,L.bndLastIntPay = Just d}) bndMap-               let newAds = sortBy sortActionOnDate $ filteredAds ++ bResetActions-               run t{bonds = newBndMap, accounts = newAccMap} poolFlowMap (Just newAds) rates calls rAssump log-           -        RefiBond d accName bnd -> Left "Undefined action: RefiBond"--        TestCall d ->-          let -            timeBasedTests::[Pre] = snd (fromMaybe ([],[]) calls)-          in-            do -              flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- timeBasedTests ]-              case any id flags of-                True -> -                  let -                     runContext = RunContext poolFlowMap rAssump rates-                     newStLogs = if null cleanUpActions then -                                   DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call"]-                                 else -                                   DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call", RunningWaterfall d W.CleanUp]-                  in  -                     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"), poolFlowMap) -- `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 -> 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---        _ -> Left $ "Failed to match action on Date"++ show ad--       where-         cleanUpActions = Map.findWithDefault [] W.CleanUp (waterfall t) -- `debug` ("Running AD"++show(ad))-         remainCollectionNum = Map.elems $ Map.map (\(x,_) -> CF.sizeCashFlowFrame x ) poolFlowMap-         futureCashToCollectFlag = and $ Map.elems $ Map.map (\(pcf,_) -> all CF.isEmptyRow2 (view CF.cashflowTxn pcf)) poolFlowMap---run t empty Nothing Nothing Nothing Nothing log-  = do-      (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 ,empty) -- `debug` ("End with pool CF is []")------ reserved for future used-data ExpectReturn = DealLogs-                  | AssetLevelFlow-                  deriving (Show,Generic,Ord,Eq)----- priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [(Date,Balance)])-priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [Txn])--- No projected transaction, use history cashflow only-priceBondIrr AP.BuyBond {} [] = Left "No transaction to buy the bond" -priceBondIrr (AP.HoldingBond historyCash _ _) [] -  = let -      (ds,vs) = unzip historyCash-      txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ]-    in -      do -        irr <- Analytics.calcIRR ds vs-        return (irr, txns')--- Projected transaction and hold to maturity-priceBondIrr (AP.HoldingBond historyCash holding Nothing) txns-  = let -      begBal = (getTxnBegBalance . head) txns-      holdingPct = divideBB holding begBal-      bProjectedTxn = scaleTxn holdingPct <$> txns -- `debug` ("holding pct"++ show holding ++"/" ++ show begBal ++" : " ++ show holdingPct)-      (ds,vs) = unzip historyCash-      (ds2,vs2) = (getDate <$> bProjectedTxn, getTxnAmt <$> bProjectedTxn) -- `debug` ("projected txn position"++ show bProjectedTxn)-      -      txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ]-    in -      do -        irr <- Analytics.calcIRR (ds++ds2) (vs++vs2) -- `debug` ("projected holding"++ show (ds2,vs2))-        return (irr, txns' ++ bProjectedTxn)---- TODO: need to use DC from bond--- Projected transaction and sell at a Date-priceBondIrr (AP.HoldingBond historyCash holding (Just (sellDate, sellPricingMethod))) txns-  = let -      -- history cash-      (ds,vs) = unzip historyCash-      txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ]-      -      begBal = (getTxnBegBalance . head) txns-      holdingPct = toRational $ holding / begBal-      -- assume cashflow of sell date belongs to seller(owner)-      (bProjectedTxn',futureFlow') = splitByDate txns sellDate EqToLeft-      (bProjectedTxn,futureFlow) = ((scaleTxn holdingPct) <$> bProjectedTxn',(scaleTxn holdingPct) <$> futureFlow')-      -- projected cash-      (ds2,vs2) = (getDate <$> bProjectedTxn, getTxnAmt <$> bProjectedTxn)-      -- accrued interest-      accruedInt = L.backoutAccruedInt sellDate epocDate (bProjectedTxn++futureFlow)-      (ds3,vs3) = (sellDate, accruedInt)  -- `debug` ("accrued interest"++ show (accruedInt,sellDate))-      -- sell price -      sellPrice = case sellPricingMethod of -                    BondBalanceFactor f -> case bProjectedTxn of -                                            [] -> mulBR begBal (f * holdingPct) -                                            _txns -> mulBR (getTxnBalance (last _txns)) f-      (ds4,vs4) = (sellDate,  sellPrice)  -- `debug` ("sale price, date"++ show (sellPrice,sellDate))-    in -      do -        irr <- Analytics.calcIRR (ds++ds2++[ds3]++[ds4]) (vs++vs2++[vs3]++[vs4]) -- `debug` ("vs:"++ show vs++ "vs2:"++ show vs2++ "vs3:"++ show vs3++ "vs4:"++ show vs4 ++">>> ds "++ show ds++ "ds2"++ show ds2++ "ds3"++ show ds3++ "ds4"++ show ds4)-        return (irr, txns'++ bProjectedTxn++ [(BondTxn sellDate 0 vs3 sellPrice 0 (sellPrice+vs3) 0 0 Nothing Types.Empty)]) ---- Buy and hold to maturity-priceBondIrr (AP.BuyBond dateToBuy bPricingMethod (AP.ByCash cash) Nothing) txns-  | null futureFlow' = Left "No transaction to buy bond"-  | otherwise-    = let -      -- balance of bond on buy date-      nextTxn = head futureFlow'-      balAsBuyDate = getTxnBegBalance nextTxn-      buyPrice = case bPricingMethod of -                    BondBalanceFactor f -> mulBR balAsBuyDate f -      buyPaidOut = min buyPrice cash-      buyPct = divideBB buyPaidOut buyPrice-      boughtTxns = scaleTxn buyPct <$> futureFlow'-      -- buy price (including accrued interest)--      accuredInt = let-                    --TODO what about interest over interest-                    accruedInt' = calcInt balAsBuyDate dateToBuy (getDate nextTxn) (getTxnRate nextTxn) DC_ACT_365F-                    x = nextTxn-                    totalInt' = (fromMaybe 0) <$> [(preview (_BondTxn . _3 ) x), (preview (_BondTxn . _7 ) x), (preview (_BondTxn . _8 ) x)]-                   in-                    sum(totalInt') - accruedInt'--      (ds1, vs1) = (dateToBuy, negate (buyPaidOut + accuredInt))-      (ds2, vs2) = (getDate <$> futureFlow', getTxnAmt <$> boughtTxns)-    in -      do -        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)-    (bProjectedTxn',futureFlow') = splitByDate txns dateToBuy EqToLeft---priceBonds :: Ast.Asset a => TestDeal a -> AP.BondPricingInput -> Either String (Map.Map String PriceResult)--- Price bond via discount future cashflow-priceBonds t (AP.DiscountCurve d dc) = Right $ Map.map (L.priceBond d dc) (viewBondsInMap t)--- Run Z-Spread-priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bondPrices) -  = sequenceA $ -      Map.mapWithKey -        (\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) -  = let-      -- Date -      d = getNextBondPayDate t-      -- get projected bond txn-      projectedTxns xs = snd $ splitByDate xs d EqToRight -      -- (Maybe Bond,IrrType)-      bndMap' = Map.mapWithKey (\k v -> (getBondByName t True k, v)) bMapInput-      -- (Rate, [(date, cash)])-      bndMap'' = Map.mapWithKey (\bName (Just b, v) -> -                                  do -                                    let _irrTxns = projectedTxns (getAllTxns b)-                                    (_irr, flows) <- priceBondIrr v _irrTxns-                                    return (IrrResult (fromRational _irr) flows))-                                bndMap'-    in -      sequenceA bndMap''----- ^ split call option assumption , --- lefts are for waterfall payment days--- rights are for date-based calls-splitCallOpts :: AP.CallOpt -> ([Pre],[Pre])-splitCallOpts (AP.CallPredicate ps) = (ps,[])-splitCallOpts (AP.LegacyOpts copts) = -    let -      cFn (C.PoolBalance bal) = If L (CurrentPoolBalance Nothing) bal-      cFn (C.BondBalance bal) = If L CurrentBondBalance bal-      cFn (C.PoolFactor r) = IfRate L (PoolFactor Nothing) (fromRational r)-      cFn (C.BondFactor r) = IfRate L BondFactor (fromRational r)-      cFn (C.OnDate d) = IfDate E d-      cFn (C.AfterDate d) = IfDate G d-      cFn (C.And _opts) = Types.All [ cFn o | o <- _opts  ]-      cFn (C.Or _opts) = Types.Any [ cFn o | o <- _opts  ]-      cFn (C.Pre p) = p-    in -      ([ cFn copt | copt <- copts ],[])--- legacyCallOptConvert (AP.CallOptions opts) = concat [ legacyCallOptConvert o | o <- opts ]-splitCallOpts (AP.CallOnDates dp ps) = ([],ps)----- <Legacy Test>, <Test on dates>-readCallOptions :: [AP.CallOpt] -> ([Pre],[Pre])-readCallOptions [] = ([],[])-readCallOptions opts = -  let -    result = splitCallOpts <$> opts-  in -    (concat (fst <$> result), concat (snd <$> result))---runDeal :: Ast.Asset a => TestDeal a -> S.Set ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption-        -> 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 -    = do -        (newT, ads, pcf, unStressPcf) <- getInits er t perfAssumps (Just nonPerfAssumps)  -        (_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)-        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 poolFlowUnUsed))-		 , bndPricing-	         , poolFlowUnUsed-	       ) -- `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)-      -- extract Revolving Assumption-      mRevolvingCtx = case mRevolving of-                        Nothing -> Nothing-                        Just (AP.AvailableAssets rp rperf) -> Just (Map.fromList [("Consol", (rp, rperf))])-                        Just (AP.AvailableAssetsBy rMap) -> Just rMap-      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--      -- run() is a recusive function loop over all actions till deal end conditions are met-      --- | get bond principal and interest shortfalls from a deal-getRunResult :: Ast.Asset a => TestDeal a -> [ResultComponent]-getRunResult t = os_bn_i ++ os_bn_b -- `debug` ("Done with get result")-  where -    bs = viewDealAllBonds t  -    os_bn_b = [ BondOutstanding (L.bndName _b) (L.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)----- | 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 -      consolePoolFlowFn = over CF.cashflowTxn CF.dropTailEmptyTxns-      rmAssetLevelFn xs -        | S.member AssetLevelFlow er = xs-	| otherwise = []-    in -      t {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap-	 ,pool = poolType & over (_MultiPool . mapped . P.poolFutureCf . _Just ._1) consolePoolFlowFn -	                  & over (_ResecDeal . mapped . uDealFutureCf) consolePoolFlowFn-			  & over (_MultiPool . mapped . P.poolFutureCf . _Just . _2 . _Just) rmAssetLevelFn -	}---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-      newPt = case pt of-                MultiPool poolM -> -                  MultiPool $-                    Map.foldrWithKey-                      (\k (CF.CashFlowFrame st txnCollected, mAssetFlow) acc ->-                        let -                          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 -                                             0 -> 0 -                                             _ ->  view CF.tsRowBalance $ last txnCollected-                          txnToAppend = CF.patchCumulative currentStats [] txnCollected-			  -- insert aggregated pool flow-                          accUpdated =  Map.adjust-			                  (\_v -> case (P.futureCf _v) of-					            Nothing -> set P.poolFutureCf (Just (CF.CashFlowFrame st txnCollected , Nothing)) _v-						    Just _ -> over (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (++ txnToAppend) _v-				          )-					  k-					  acc -			  -- 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 %~ (over (P.poolFutureCf . _Just . _2) appendFn)-                        in -                          Map.adjust -                            (over P.poolIssuanceStat (Map.insert RuntimeCurrentPoolBalance balInCollected))-                            k accUpdated') -                      poolM -                      poolInflowMap-                ResecDeal uds -> -                  ResecDeal $ -                    Map.foldrWithKey-                      (\k (CF.CashFlowFrame _ newTxns, _) acc->-                        Map.adjust (over uDealFutureTxn (++ newTxns)) k acc)-                      uds-		      poolInflowMap-    in -      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 $ set (mapped . P.poolFutureCf) Nothing pm -              ResecDeal uds -> ResecDeal uds-  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)]--- schedule cashflow with stress assumption-runPool (P.Pool []  (Just (CF.CashFlowFrame _ txn,_)) _ asof _ (Just dp)) (Just (AP.PoolLevel assumps)) mRates -  = sequenceA [ Ast.projCashflow (ACM.ScheduleMortgageFlow asof txn dp) asof assumps mRates ] -- `debug` ("PROJ in schedule flow")---- project contractual cashflow if nothing found in pool perf assumption--- use interest rate assumption-runPool (P.Pool as _ _ asof _ _) Nothing mRates -  = do -      cf <- sequenceA $ parMap rdeepseq  -                              (\x -> Ast.calcCashflow x asof mRates) -                              as -      return [ (x, Map.empty) | x <- cf ]--- asset cashflow with credit stress----- By pool level-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  asof _ _) (Just (AP.ByIndex idxAssumps)) mRates =-  let-    numAssets = length as-  in-    do -      _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-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] -    --               -> [c] -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)] -    matchAssets []   _ [] = Right [(CF.CashFlowFrame (0,epocDate,Nothing) [], Map.empty)] -    matchAssets cfs [] [] = sequenceA cfs-    -- matchAssets cfs [] astList = sequenceA $ cfs ++ ((\x -> (\y -> (y, Map.empty)) <$> (Ast.calcCashflow x asof mRates)) <$> astList)-    matchAssets cfs [] astList = let-                                    poolCfs = parMap rdeepseq (\x -> Ast.calcCashflow x asof mRates) astList-                                    poolCfs' = (\x -> (, Map.empty) <$> x) <$> poolCfs-                                 in -                                    sequenceA $ cfs ++ poolCfs'-    matchAssets cfs (rule:rules) astList = -      case rule of -        AP.ObligorById ids assetPerf -          -> let -               idSet = S.fromList ids-               (matchedAsts,unMatchedAsts) = partition -                                               (\x -> case Ast.getObligorId x of -                                                         Just oid -> S.member oid idSet-                                                         Nothing -> False) -                                               astList-               matchedCfs = parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) matchedAsts -             in -               matchAssets (cfs ++ matchedCfs) rules unMatchedAsts-        AP.ObligorByTag tags tagRule assetPerf ->-          let -            obrTags = S.fromList tags--            matchRuleFn AP.TagEq s1 s2 = s1 == s2 -            matchRuleFn AP.TagSubset s1 s2 = s1 `S.isSubsetOf` s2-            matchRuleFn AP.TagSuperset s1 s2 = s2 `S.isSubsetOf` s1-            matchRuleFn AP.TagAny s1 s2 = not $ S.null $ S.intersection s1 s2-            matchRuleFn (AP.TagNot tRule) s1 s2 = not $ matchRuleFn tRule s1 s2-            -            (matchedAsts,unMatchedAsts) = partition (\x -> matchRuleFn tagRule (Ast.getObligorTags x) obrTags) astList-            matchedCfs = parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) matchedAsts -          in -            matchAssets (cfs ++ matchedCfs) rules unMatchedAsts-        -        AP.ObligorByField fieldRules assetPerf -> -          let -            matchRuleFn (AP.FieldIn fv fvals) Nothing = False-            matchRuleFn (AP.FieldIn fv fvals) (Just fm) = case Map.lookup fv fm of-                                                    Just (Left v) -> v `elem` fvals-                                                    Nothing -> False-            matchRuleFn (AP.FieldCmp fv cmp dv) (Just fm) = case Map.lookup fv fm of-                                                        Just (Right v) -> case cmp of -                                                                    G -> v > dv-                                                                    L -> v < dv-                                                                    GE -> v >= dv-                                                                    LE -> v <= dv-                                                        Nothing -> False-            matchRuleFn (AP.FieldInRange fv rt dv1 dv2) (Just fm) = -              case Map.lookup fv fm of-                Just (Right v) -> case rt of -                          II -> v <= dv2 && v >= dv1-                          IE -> v <= dv2 && v > dv1-                          EI -> v < dv2 && v >= dv1-                          EE -> v < dv2 && v > dv1-                          _ -> False-                Nothing -> False-            matchRuleFn (AP.FieldNot fRule) fm = not $ matchRuleFn fRule fm--            matchRulesFn fs fm = all (`matchRuleFn` fm) fs--            (matchedAsts,unMatchedAsts) = partition (matchRulesFn fieldRules . Ast.getObligorFields) astList            -            matchedCfs = parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) matchedAsts -          in -            matchAssets (cfs ++ matchedCfs) rules unMatchedAsts-        AP.ObligorByDefault assetPerf ->-          matchAssets -            (cfs ++ (parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) astList))-            []-            []-  in-    matchAssets [] obligorRules as------ safe net to catch other cases-runPool _a _b _c = Left $ "[Run Pool]: 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 (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-    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.PoolCashflow -> PoolType a -> PoolType a-patchScheduleFlow flowM pt = -  case pt of-    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-patchRuntimeBal balMap (MultiPool pM) -  = MultiPool $-      Map.mapWithKey-        (\k p -> over P.poolIssuanceStat -                      (Map.insert RuntimeCurrentPoolBalance (Map.findWithDefault 0.0 k balMap)) -                      p)-        pM--patchRuntimeBal balMap pt = pt---runPoolType :: Ast.Asset a => Bool -> PoolType a -> Maybe AP.ApplyAssumptionType -            -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId CF.PoolCashflow)--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 -> -		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 flag (ResecDeal dm) mAssumps mNonPerfAssump-  = -    let -      assumpMap =  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-      ranMap =   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 (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 => 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 ] -  in -    do -      (startDate,closingDate,firstPayDate,pActionDates,bActionDates,endDate,custWdates) <- populateDealDates (dates t) status--      let intEarnDates = A.buildEarnIntAction (Map.elems (accounts t)) endDate [] -      let intAccRateResetDates = (A.buildRateResetDates endDate) <$> (Map.elems (accounts t))-      let iAccIntDates = [ EarnAccInt _d accName | (accName,accIntDates) <- intEarnDates , _d <- accIntDates ] -      let iAccRateResetDates = concat [ [ResetAccRate _d accName | _d <- _ds] | rst@(Just (accName, _ds)) <- intAccRateResetDates, isJust rst ]-    -      --fee accrue dates -      let _feeAccrueDates = F.buildFeeAccrueAction (Map.elems feeMap) endDate [] -      let feeAccrueDates = [ AccrueFee _d _feeName | (_feeName,feeAccureDates) <- _feeAccrueDates , _d <- feeAccureDates ]-    --liquidation facility-      let liqResetDates = case liqProvider t of -                        Nothing -> []-                        Just mLiqProvider -> -                            let -                              _liqResetDates = CE.buildLiqResetAction (Map.elems mLiqProvider) endDate []-                              _liqRateResetDates = CE.buildLiqRateResetAction (Map.elems mLiqProvider) endDate []-                            in -                              [ ResetLiqProvider _d _liqName |(_liqName,__liqResetDates) <- _liqResetDates , _d <- __liqResetDates ]-                              ++ -                              [ ResetLiqProviderRate _d _liqName |(_liqName,__liqResetDates) <- _liqRateResetDates , _d <- __liqResetDates ]                            -    --inspect dates -      let inspectDates = case mNonPerfAssump of-                          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 -                                   (s:_ds) = genSerialDatesTill2 II startDate dp endDate -                                 in -                                   [ BuildReport _sd _ed  | (_sd,_ed) <- zip (s:_ds) _ds ] -- `debug` ("ds"++ show _ds)-                            _ -> []--      let irUpdateSwapDates = case rateSwap t of-                          Nothing -> []-                          Just rsm -> Map.elems $ Map.mapWithKey -                                                   (\k x -> let -                                                             resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) (HE.rsUpdateDates x) endDate-                                                            in -                                                             flip CalcIRSwap k <$> resetDs)-                                                   rsm-      let irSettleSwapDates = case rateSwap t of-                          Nothing -> []-                          Just rsm -> Map.elems $ Map.mapWithKey -                                                    (\k x@HE.RateSwap{ HE.rsSettleDates = sDates} ->-                                                      case sDates of -                                                        Nothing -> []-                                                        Just (sdp,_) ->-                                                          let -                                                            resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) sdp endDate-                                                          in -                                                            flip SettleIRSwap k <$> resetDs)-                                                    rsm-      let rateCapSettleDates = case rateCap t of -                             Nothing -> []-                             Just rcM -> Map.elems $ Map.mapWithKey -                                                       (\k x -> let -                                                                  resetDs = genSerialDatesTill2 EE (HE.rcStartDate x) (HE.rcSettleDates x) endDate-                                                                in -                                                                  flip AccrueCapRate k <$> resetDs)-                                                       rcM-    -- bond rate resets -      let bndRateResets = let -                        bndWithDate = Map.toList $ Map.map -                                                  (\b -> L.buildRateResetDates b closingDate endDate) -                                                  bndMap-                      in -                        [ ResetBondRate bdate bn | (bn, bdates) <- bndWithDate-                                                    , bdate <- bdates ] --    -- bond step ups events-      let bndStepUpDates = let -                        bndWithDate = Map.toList $ Map.map -                                                  (\b -> L.buildStepUpDates b closingDate endDate) -                                                  bndMap-                      in-                        [ StepUpBondRate bdate bn  | (bn, bdates) <- bndWithDate , bdate <- bdates ] --    -- mannual triggers -      let mannualTrigger = case mNonPerfAssump of -                            Just AP.NonPerfAssumption{AP.fireTrigger = Just evts} -> [ FireTrigger d cycle n | (d,cycle,n) <- evts]-                            _ -> []--    -- make whole assumption-      let makeWholeDate = case mNonPerfAssump of-                            Just AP.NonPerfAssumption{AP.makeWholeWhen = Just (_d,_s,_t)} -> [MakeWhole _d _s _t]-                            _ -> [] --    -- issue bonds in the future -      let bondIssuePlan = case mNonPerfAssump of -                            Just AP.NonPerfAssumption{AP.issueBondSchedule = Just bndPlan} -                              -> [ IssueBond _d mPre bGroupName accName b mBal mRate | TsPoint _d (AP.IssueBondEvent mPre bGroupName accName b mBal mRate) <- bndPlan]-                                  ++ [FundBond _d mPre bName accName amount | TsPoint _d (AP.FundingBondEvent mPre bName accName amount) <- bndPlan]-                            _ -> []--    -- refinance bonds in the future -      let bondRefiPlan = case mNonPerfAssump of -                        Just AP.NonPerfAssumption{AP.refinance = Just bndPlan} -                          -> [ RefiBondRate _d accName bName iInfo | TsPoint _d (AP.RefiRate accName bName iInfo) <- bndPlan]-                            ++ [ RefiBond _d accName bnd | TsPoint _d (AP.RefiBond accName bnd) <- bndPlan] -                             -                        _ -> []--      let extractTestDates (AP.CallOnDates dp _) = [TestCall x | x <- genSerialDatesTill2 EE startDate dp endDate ]-      let extractTestDates _ = []-    -- extractTestDates (AP.CallOptions opts) = concat [ extractTestDates opt | opt <- opts ]-    -- call test dates -      let callDates = case mNonPerfAssump of-                    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, stopTestDates-                                                     ,bondIssuePlan,bondRefiPlan,callDates, iAccRateResetDates -                                                     ,bndStepUpDates] -                                        in-                                          case (dates t,status) of -                                            (PreClosingDates {}, PreClosing _) -> sortBy sortActionOnDate $ DealClosed closingDate:a -                                            _ -> sortBy sortActionOnDate a-                         _actionDates = __actionDates++[HitStatedMaturity endDate]-                       in -                         case mNonPerfAssump of-                           Just AP.NonPerfAssumption{AP.stopRunBy = Just (AP.StopByDate d)} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d]-                           _ -> _actionDates  -     -      let newFeeMap = case mNonPerfAssump of-                        Nothing -> feeMap-                        Just AP.NonPerfAssumption{AP.projectedExpense = Nothing } -> 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 True thePool mAssumps mNonPerfAssump-      pScheduleCfM <- runPoolType True thePool Nothing mNonPerfAssump-      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 -				      ((\(_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)]))-                    else -                      _stats-      return (t {fees = newFeeMap , pool = poolWithRunPoolBalance , stats = newStat}-             , allActionDates-             , pCollectionCfAfterCutoff-             , pUnstressedAfterCutoff)---- ^ UI translation : to read pool cash-readProceeds :: PoolSource -> CF.TsRow -> Either String Balance-readProceeds CollectedInterest x = Right $ CF.mflowInterest x-readProceeds CollectedPrincipal x = Right $ CF.mflowPrincipal x-readProceeds CollectedRecoveries x = Right $ CF.mflowRecovery x-readProceeds CollectedPrepayment x = Right $ CF.mflowPrepayment x-readProceeds CollectedRental  x    = Right $ CF.mflowRental x-readProceeds CollectedPrepaymentPenalty x = Right $ CF.mflowPrepaymentPenalty x-readProceeds CollectedCash x = Right $ CF.tsTotalCash x-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.PoolCashflow -> [CF.TsRow]-extractTxnsFromFlowFrameMap mPids pflowMap = -  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.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-      let amt = sum amts-      return $ Map.adjust (A.deposit amt d (PoolInflow mPids s)) an amap-    where -      txns =  extractTxnsFromFlowFrameMap mPids pFlowMap---depositInflow d (W.CollectByPct mPids s splitRules) pFlowMap amap    --TODO need to check 100%-  = do -      amts <- sequenceA $ readProceeds s <$> txns-      let amt = sum amts-      let amtsToAccs = [ (an, mulBR amt splitRate) | (splitRate, an) <- splitRules]-      return $ -              foldr-                (\(accName,accAmt) accM -> -                  Map.adjust (A.deposit accAmt d (PoolInflow mPids s)) accName accM)-                amap-                amtsToAccs-    where -      txns =  extractTxnsFromFlowFrameMap mPids pFlowMap ---- ^ 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-  -- = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules-  = foldM (\acc rule -> depositInflow d rule pFlowMap acc) amap rules+module Deal (run,getInits,runDeal,ExpectReturn(..)+            ,performAction+            ,populateDealDates+            ,calcTargetAmount,updateLiqProvider+            ,projAssetUnion,priceAssetUnion+            ,removePoolCf,runPoolType,PoolType+            ,ActionOnDate(..),DateDesp(..)+            ,changeDealStatus+            ) where++import Control.Parallel.Strategies+import qualified Accounts as A+import qualified Ledger as LD+import qualified Asset as Ast+import qualified Pool as P+import qualified Expense as F+import qualified Liability as L+import qualified CreditEnhancement as CE+import qualified Analytics+import qualified Waterfall as W+import qualified Cashflow as CF+import qualified Assumptions as AP+import qualified Reports as Rpt+import qualified AssetClass.AssetBase as ACM+import AssetClass.Mortgage+import AssetClass.Lease+import AssetClass.Loan+import AssetClass.Installment+import AssetClass.MixedAsset++import qualified Call as C+import qualified InterestRate as IR+import Deal.DealBase+import Deal.DealQuery+import Deal.DealAction+import Deal.DealCollection+import Deal.DealRun+import qualified Deal.DealValidation as V+import Stmt+import Lib+import Util+import DateUtil+import Types+import Revolving+import Triggers++import qualified Data.Map as Map hiding (mapEither)+import qualified Data.Time as T+import qualified Data.Set as S+import qualified Control.Lens as LS+import Data.List+import qualified Data.DList as DL+import Data.Fixed+import Data.Time.Clock+import Data.Maybe+import Data.Either+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+import GHC.Generics+import Control.Monad+import Control.Monad.Writer+import Control.Monad.Loops (allM,anyM)+import Control.Applicative (liftA2)++import Debug.Trace+import Cashflow (buildBegTsRow)+import Assumptions (NonPerfAssumption(NonPerfAssumption),lookupRate0)+import Asset ()+import Pool (issuanceStat)+import qualified Types as P+import Control.Lens hiding (element)+import Control.Lens.TH+import Data.Either.Utils+import InterestRate (calcInt)+import Liability (getDayCountFromInfo,getTxnRate)+import Hedge (RateCap(..),RateSwapBase(..),RateSwap(rsRefBalance))+import qualified Hedge as HE++debug = flip trace+++updateSrtRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> HE.SRT -> Either String HE.SRT+updateSrtRate t d ras srt@HE.SRT{HE.srtPremiumType = rt} +    = do +        r <- AP.applyFloatRate2 rt d ras +        return srt { HE.srtPremiumRate = r }+++accrueSrt :: Ast.Asset a => TestDeal a -> Date -> HE.SRT -> Either String HE.SRT+accrueSrt t d srt@HE.SRT{ HE.srtDuePremium = duePrem, HE.srtRefBalance = bal, HE.srtPremiumRate = rate+                        , HE.srtDuePremiumDate = mDueDate,  HE.srtType = st+                        , HE.srtStart = sd } +  = do +      newBal <- case st of+                  HE.SrtByEndDay ds dp -> queryCompound t d (patchDateToStats d ds)+      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}+++-- ^ test if a clean up call should be fired+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.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 +       C.AfterDate x -> Right $ d > x+       C.And xs -> allM (testCall t d) xs+       C.Or xs -> anyM (testCall t d) xs+       -- C.And xs -> (all id) <$> sequenceA $ [testCall t d x | x <- xs]+       -- C.Or xs -> (any id) <$> sequenceA $ [testCall t d x | x <- xs]+       C.Pre pre -> testPre d t pre+       _ -> Left ("failed to find call options"++ show opt)+++queryTrigger :: Ast.Asset a => TestDeal a -> DealCycle -> [Trigger]+queryTrigger t@TestDeal{ triggers = trgs } wt +  = case trgs of +      Nothing -> []+      Just _trgs -> maybe [] Map.elems $ Map.lookup wt _trgs++-- ^ test triggers in the deal and add a log if deal status changed+changeDealStatus:: Ast.Asset a => (Date,String)-> DealStatus -> TestDeal a -> (Maybe ResultComponent, TestDeal a)+changeDealStatus _ _ t@TestDeal{status=Ended _} = (Nothing, t) +changeDealStatus (d,why) newSt t@TestDeal{status=oldSt} +  | newSt /= oldSt = (Just (DealStatusChangeTo d oldSt newSt why), t {status=newSt})+  | otherwise = (Just (DealStatusChangeTo d oldSt newSt ("Duplicate status change: "++why)), t) +++-- reserved for future used+data ExpectReturn = DealLogs+                  | AssetLevelFlow+                  deriving (Show,Generic,Ord,Eq)+++-- priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [(Date,Balance)])+priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [Txn])+-- No projected transaction, use history cashflow only+priceBondIrr AP.BuyBond {} [] = Left "No transaction to buy the bond" +priceBondIrr (AP.HoldingBond historyCash _ _) [] +  = let +      (ds,vs) = unzip historyCash+      txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ]+    in +      do +        irr <- Analytics.calcIRR ds vs+        return (irr, txns')+-- Projected transaction and hold to maturity+priceBondIrr (AP.HoldingBond historyCash holding Nothing) txns+  = let +      begBal = (getTxnBegBalance . head) txns+      holdingPct = divideBB holding begBal+      bProjectedTxn = scaleTxn holdingPct <$> txns -- `debug` ("holding pct"++ show holding ++"/" ++ show begBal ++" : " ++ show holdingPct)+      (ds,vs) = unzip historyCash+      (ds2,vs2) = (getDate <$> bProjectedTxn, getTxnAmt <$> bProjectedTxn) -- `debug` ("projected txn position"++ show bProjectedTxn)+      +      txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ]+    in +      do +        irr <- Analytics.calcIRR (ds++ds2) (vs++vs2) -- `debug` ("projected holding"++ show (ds2,vs2))+        return (irr, txns' ++ bProjectedTxn)++-- TODO: need to use DC from bond+-- Projected transaction and sell at a Date+priceBondIrr (AP.HoldingBond historyCash holding (Just (sellDate, sellPricingMethod))) txns+  = let +      -- history cash+      (ds,vs) = unzip historyCash+      txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ]+      +      begBal = (getTxnBegBalance . head) txns+      holdingPct = toRational $ holding / begBal+      -- assume cashflow of sell date belongs to seller(owner)+      (bProjectedTxn',futureFlow') = splitByDate txns sellDate EqToLeft+      (bProjectedTxn,futureFlow) = ((scaleTxn holdingPct) <$> bProjectedTxn',(scaleTxn holdingPct) <$> futureFlow')+      -- projected cash+      (ds2,vs2) = (getDate <$> bProjectedTxn, getTxnAmt <$> bProjectedTxn)+      -- accrued interest+      accruedInt = L.backoutAccruedInt sellDate epocDate (bProjectedTxn++futureFlow)+      (ds3,vs3) = (sellDate, accruedInt)  -- `debug` ("accrued interest"++ show (accruedInt,sellDate))+      -- sell price +      sellPrice = case sellPricingMethod of +                    BondBalanceFactor f -> case bProjectedTxn of +                                            [] -> mulBR begBal (f * holdingPct) +                                            _txns -> mulBR (getTxnBalance (last _txns)) f+      (ds4,vs4) = (sellDate,  sellPrice)  -- `debug` ("sale price, date"++ show (sellPrice,sellDate))+    in +      do +        irr <- Analytics.calcIRR (ds++ds2++[ds3]++[ds4]) (vs++vs2++[vs3]++[vs4]) -- `debug` ("vs:"++ show vs++ "vs2:"++ show vs2++ "vs3:"++ show vs3++ "vs4:"++ show vs4 ++">>> ds "++ show ds++ "ds2"++ show ds2++ "ds3"++ show ds3++ "ds4"++ show ds4)+        return (irr, txns'++ bProjectedTxn++ [BondTxn sellDate 0 vs3 sellPrice 0 (sellPrice+vs3) 0 0 Nothing Types.Empty]) ++-- Buy and hold to maturity+priceBondIrr (AP.BuyBond dateToBuy bPricingMethod (AP.ByCash cash) Nothing) txns+  | null futureFlow' = Left "No transaction to buy bond"+  | otherwise+    = let +      -- balance of bond on buy date+      nextTxn = head futureFlow'+      balAsBuyDate = getTxnBegBalance nextTxn+      buyPrice = case bPricingMethod of +                    BondBalanceFactor f -> mulBR balAsBuyDate f +      buyPaidOut = min buyPrice cash+      buyPct = divideBB buyPaidOut buyPrice+      boughtTxns = scaleTxn buyPct <$> futureFlow'+      -- buy price (including accrued interest)++      accuredInt = let+                    --TODO what about interest over interest+                    accruedInt' = calcInt balAsBuyDate dateToBuy (getDate nextTxn) (getTxnRate nextTxn) DC_ACT_365F+                    x = nextTxn+                    totalInt' = (fromMaybe 0) <$> [(preview (_BondTxn . _3 ) x), (preview (_BondTxn . _7 ) x), (preview (_BondTxn . _8 ) x)]+                   in+                    sum(totalInt') - accruedInt'++      (ds1, vs1) = (dateToBuy, negate (buyPaidOut + accuredInt))+      (ds2, vs2) = (getDate <$> futureFlow', getTxnAmt <$> boughtTxns)+    in +      do +        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)+    (bProjectedTxn',futureFlow') = splitByDate txns dateToBuy EqToLeft+++priceBonds :: Ast.Asset a => TestDeal a -> AP.BondPricingInput -> Either String (Map.Map String PriceResult)+-- Price bond via discount future cashflow+priceBonds t (AP.DiscountCurve d dc) = Right $ Map.map (L.priceBond d dc) (viewBondsInMap t)+-- Run Z-Spread+priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bondPrices) +  = sequenceA $ +      Map.mapWithKey +        (\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) +  = let+      -- Date +      d = getNextBondPayDate t+      -- get projected bond txn+      projectedTxns xs = snd $ splitByDate xs d EqToRight +      -- (Maybe Bond,IrrType)+      bndMap' = Map.mapWithKey (\k v -> (getBondByName t True k, v)) bMapInput+      -- (Rate, [(date, cash)])+      bndMap'' = Map.mapWithKey (\bName (Just b, v) -> +                                  do +                                    let _irrTxns = projectedTxns (getAllTxns b)+                                    (_irr, flows) <- priceBondIrr v _irrTxns+                                    return (IrrResult (fromRational _irr) flows))+                                bndMap'+    in +      sequenceA bndMap''++++-- <Legacy Test>, <Test on dates>++runDeal :: Ast.Asset a => TestDeal a -> S.Set ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption+        -> 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 +    = do +        (newT, ads, pcf, unStressPcf) <- getInits er t perfAssumps (Just nonPerfAssumps)  +        (_finalDeal, logs, osPoolFlow) <- run (removePoolCf newT) +                                              pcf+                                              (Just ads) +                                              mInterest+                                              (AP.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)+        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 poolFlowUnUsed))+		 , bndPricing+	         , poolFlowUnUsed+	       ) -- `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)+      -- extract Revolving Assumption+      mRevolvingCtx = case mRevolving of+                        Nothing -> Nothing+                        Just (AP.AvailableAssets rp rperf) -> Just (Map.fromList [("Consol", (rp, rperf))])+                        Just (AP.AvailableAssetsBy rMap) -> Just rMap+      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++      -- run() is a recusive function loop over all actions till deal end conditions are met+      +-- | get bond principal and interest shortfalls from a deal+getRunResult :: Ast.Asset a => TestDeal a -> [ResultComponent]+getRunResult t = os_bn_i ++ os_bn_b -- `debug` ("Done with get result")+  where +    bs = viewDealAllBonds t  +    os_bn_b = [ BondOutstanding (L.bndName _b) (L.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)+++-- | 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 +      consolePoolFlowFn = over CF.cashflowTxn CF.dropTailEmptyTxns+      rmAssetLevelFn xs +        | S.member AssetLevelFlow er = xs+	| otherwise = []+    in +      t {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap+	 ,pool = poolType & over (_MultiPool . mapped . P.poolFutureCf . _Just ._1) consolePoolFlowFn +	                  & over (_ResecDeal . mapped . uDealFutureCf . _Just) consolePoolFlowFn+			  & over (_MultiPool . mapped . P.poolFutureCf . _Just . _2 . _Just) rmAssetLevelFn +	}+++-- ^ 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 $ set (mapped . P.poolFutureCf) Nothing pm +              ResecDeal uds -> ResecDeal uds+  in+    t {pool = newPt}++runPoolType :: Ast.Asset a => Bool -> PoolType a -> Maybe AP.ApplyAssumptionType +            -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId CF.PoolCashflow)++runPoolType flag (MultiPool pm) (Just poolAssumpType) mNonPerfAssump+  = let +      rateAssump = AP.interest =<< mNonPerfAssump+      calcPoolCashflow (AP.ByName assumpMap) pid v = P.runPool v (AP.PoolLevel <$> Map.lookup pid assumpMap) rateAssump 	+      calcPoolCashflow (AP.ByPoolId assumpMap) pid v = P.runPool v (Map.lookup pid assumpMap) rateAssump+      calcPoolCashflow poolAssump pid v = P.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 -> +		do+		  assetFlows <- P.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 flag (ResecDeal dm) mAssumps mNonPerfAssump+  = +    let +      assumpMap =  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+      ranMap =   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 (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+ ++-- ^ 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 (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+    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.PoolCashflow -> PoolType a -> PoolType a+patchScheduleFlow flowM pt = +  case pt of+    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+patchRuntimeBal balMap (MultiPool pM) +  = MultiPool $+      Map.mapWithKey+        (\k p -> over P.poolIssuanceStat +                      (Map.insert RuntimeCurrentPoolBalance (Map.findWithDefault 0.0 k balMap)) +                      p)+        pM++patchRuntimeBal balMap pt = pt+++   ++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 ] +  in +    do +      (startDate,closingDate,firstPayDate,pActionDates,bActionDates,endDate,custWdates) <- populateDealDates (dates t) status++      let intEarnDates = A.buildEarnIntAction (Map.elems (accounts t)) endDate [] +      let intAccRateResetDates = (A.buildRateResetDates endDate) <$> (Map.elems (accounts t))+      let iAccIntDates = [ EarnAccInt _d accName | (accName,accIntDates) <- intEarnDates , _d <- accIntDates ] +      let iAccRateResetDates = concat [ [ResetAccRate _d accName | _d <- _ds] | rst@(Just (accName, _ds)) <- intAccRateResetDates, isJust rst ]+    +      --fee accrue dates +      let _feeAccrueDates = F.buildFeeAccrueAction (Map.elems feeMap) endDate [] +      let feeAccrueDates = [ AccrueFee _d _feeName | (_feeName,feeAccureDates) <- _feeAccrueDates , _d <- feeAccureDates ]+    --liquidation facility+      let liqResetDates = case liqProvider t of +                        Nothing -> []+                        Just mLiqProvider -> +                            let +                              _liqResetDates = CE.buildLiqResetAction (Map.elems mLiqProvider) endDate []+                              _liqRateResetDates = CE.buildLiqRateResetAction (Map.elems mLiqProvider) endDate []+                            in +                              [ ResetLiqProvider _d _liqName |(_liqName,__liqResetDates) <- _liqResetDates , _d <- __liqResetDates ]+                              ++ +                              [ ResetLiqProviderRate _d _liqName |(_liqName,__liqResetDates) <- _liqRateResetDates , _d <- __liqResetDates ]                            +    --inspect dates +      let inspectDates = case mNonPerfAssump of+                          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 +                                   (s:_ds) = genSerialDatesTill2 II startDate dp endDate +                                 in +                                   [ BuildReport _sd _ed  | (_sd,_ed) <- zip (s:_ds) _ds ] -- `debug` ("ds"++ show _ds)+                            _ -> []++      let irUpdateSwapDates = case rateSwap t of+                          Nothing -> []+                          Just rsm -> Map.elems $ Map.mapWithKey +                                                   (\k x -> let +                                                             resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) (HE.rsUpdateDates x) endDate+                                                            in +                                                             flip CalcIRSwap k <$> resetDs)+                                                   rsm+      let irSettleSwapDates = case rateSwap t of+                          Nothing -> []+                          Just rsm -> Map.elems $ Map.mapWithKey +                                                    (\k x@HE.RateSwap{ HE.rsSettleDates = sDates} ->+                                                      case sDates of +                                                        Nothing -> []+                                                        Just (sdp,_) ->+                                                          let +                                                            resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) sdp endDate+                                                          in +                                                            flip SettleIRSwap k <$> resetDs)+                                                    rsm+      let rateCapSettleDates = case rateCap t of +                             Nothing -> []+                             Just rcM -> Map.elems $ Map.mapWithKey +                                                       (\k x -> let +                                                                  resetDs = genSerialDatesTill2 EE (HE.rcStartDate x) (HE.rcSettleDates x) endDate+                                                                in +                                                                  flip AccrueCapRate k <$> resetDs)+                                                       rcM+    -- bond rate resets +      let bndRateResets = let +                        bndWithDate = Map.toList $ Map.map +                                                  (\b -> L.buildRateResetDates b closingDate endDate) +                                                  bndMap+                      in +                        [ ResetBondRate bdate bn | (bn, bdates) <- bndWithDate+                                                    , bdate <- bdates ] ++    -- bond step ups events+      let bndStepUpDates = let +                        bndWithDate = Map.toList $ Map.map +                                                  (\b -> L.buildStepUpDates b closingDate endDate) +                                                  bndMap+                      in+                        [ StepUpBondRate bdate bn  | (bn, bdates) <- bndWithDate , bdate <- bdates ] ++    -- mannual triggers +      let mannualTrigger = case mNonPerfAssump of +                            Just AP.NonPerfAssumption{AP.fireTrigger = Just evts} -> [ FireTrigger d cycle n | (d,cycle,n) <- evts]+                            _ -> []++    -- make whole assumption+      let makeWholeDate = case mNonPerfAssump of+                            Just AP.NonPerfAssumption{AP.makeWholeWhen = Just (_d,_s,_t)} -> [MakeWhole _d _s _t]+                            _ -> [] ++    -- issue bonds in the future +      let bondIssuePlan = case mNonPerfAssump of +                            Just AP.NonPerfAssumption{AP.issueBondSchedule = Just bndPlan} +                              -> [ IssueBond _d mPre bGroupName accName b mBal mRate | TsPoint _d (AP.IssueBondEvent mPre bGroupName accName b mBal mRate) <- bndPlan]+                                  ++ [FundBond _d mPre bName accName amount | TsPoint _d (AP.FundingBondEvent mPre bName accName amount) <- bndPlan]+                            _ -> []++    -- refinance bonds in the future +      let bondRefiPlan = case mNonPerfAssump of +                        Just AP.NonPerfAssumption{AP.refinance = Just bndPlan} +                          -> [ RefiBondRate _d accName bName iInfo | TsPoint _d (AP.RefiRate accName bName iInfo) <- bndPlan]+                            ++ [ RefiBond _d accName bnd | TsPoint _d (AP.RefiBond accName bnd) <- bndPlan] +                             +                        _ -> []++      let extractTestDates (AP.CallOnDates dp _) = [TestCall x | x <- genSerialDatesTill2 EE startDate dp endDate ]+      let extractTestDates _ = []+    -- extractTestDates (AP.CallOptions opts) = concat [ extractTestDates opt | opt <- opts ]+    -- call test dates +      let callDates = case mNonPerfAssump of+                    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, stopTestDates+                                                     ,bondIssuePlan,bondRefiPlan,callDates, iAccRateResetDates +                                                     ,bndStepUpDates] +                                        in+                                          case (dates t,status) of +                                            (PreClosingDates {}, PreClosing _) -> sortBy sortActionOnDate $ DealClosed closingDate:a +                                            _ -> sortBy sortActionOnDate a+                         _actionDates = __actionDates++[HitStatedMaturity endDate]+                       in +                         case mNonPerfAssump of+                           Just AP.NonPerfAssumption{AP.stopRunBy = Just (AP.StopByDate d)} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d]+                           _ -> _actionDates  +     +      let newFeeMap = case mNonPerfAssump of+                        Nothing -> feeMap+                        Just AP.NonPerfAssumption{AP.projectedExpense = Nothing } -> 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 True thePool mAssumps mNonPerfAssump+      pScheduleCfM <- runPoolType True thePool Nothing mNonPerfAssump+      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 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 +				      ((\(_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)]))+                    else +                      _stats+      return (t {fees = newFeeMap , pool = poolWithRunPoolBalance , stats = newStat}+             , allActionDates+             , pCollectionCfAfterCutoff+             , pUnstressedAfterCutoff)  $(deriveJSON defaultOptions ''ExpectReturn)

@@ -1,7 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-}  module Deal.DealAction (performActionWrap,performAction,calcDueFee@@ -100,15 +97,14 @@   = zip (fst <$> bndsWithDue) $ prorataFactors (snd <$> bndsWithDue) amt  allocAmtToBonds theOrder amt bndsWithDue =   let -    sortFn = case theOrder of -                      W.ByName -> (\(b1,_) (b2,_) -> compare (L.bndName b1) (L.bndName b2)) -                      W.ByCurrentRate -> (\(b1,_) (b2,_) -> compare (L.bndRate b2) (L.bndRate b1)) -                      W.ByMaturity -> (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.maturityDate bo1) (L.maturityDate bo2))-                      W.ByStartDate -> (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.originDate bo1) (L.originDate bo2))-                      -- TODO: how to handle if now names found in the bonds-                      -- W.ByCustomNames names -> (\(b1,_) (b2,_) -> compare (findIndex (== (L.bndName b1)) names) (findIndex (== (L.bndName b2)) names))-                      W.ByCustomNames names -> (\(b1,_) (b2,_) -> compare (elemIndex (L.bndName b1) names) (elemIndex (L.bndName b2) names))-    orderedBonds = sortBy sortFn bndsWithDue+    sortFn W.ByName = (\(b1,_) (b2,_) -> compare (L.bndName b1) (L.bndName b2)) +    sortFn W.ByCurrentRate = (\(b1,_) (b2,_) -> compare (L.bndRate b2) (L.bndRate b1)) +    sortFn W.ByMaturity = (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.maturityDate bo1) (L.maturityDate bo2))+    sortFn W.ByStartDate = (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.originDate bo1) (L.originDate bo2))+               -- TODO: how to handle if now names found in the bonds+    sortFn (W.ByCustomNames names) = (\(b1,_) (b2,_) -> compare (elemIndex (L.bndName b1) names) (elemIndex (L.bndName b2) names))+    sortFn (W.ReverseSeq orderBy) = flip (sortFn orderBy)+    orderedBonds = sortBy (sortFn theOrder) bndsWithDue     orderedAmt = snd <$> orderedBonds   in      zip 

@@ -9,13 +9,13 @@ module Deal.DealBase (TestDeal(..),SPV(..),dealBonds,dealFees,dealAccounts,dealPool,PoolType(..),getIssuanceStats                      ,getAllAsset,getAllAssetList,getAllCollectedFrame,getLatestCollectFrame,getAllCollectedTxns                      ,getIssuanceStatsConsol,getAllCollectedTxnsList-                     ,getPoolIds,getBondByName, UnderlyingDeal(..), uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..)+                     ,getPoolIds,getBondByName, UnderlyingDeal(..),viewDealAllBonds,DateDesp(..),ActionOnDate(..)                      ,sortActionOnDate,dealBondGroups                      ,viewDealBondsByNames,poolTypePool,viewBondsInMap,bondGroupsBonds                      ,increaseBondPaidPeriod,increasePoolCollectedPeriod                      ,DealStatFields(..),getDealStatInt,isPreClosing,populateDealDates                      ,bondTraversal,findBondByNames,updateBondInMap-		     ,_MultiPool,_ResecDeal,uDealFutureCf,uDealFutureScheduleCf+                     ,_MultiPool,_ResecDeal,uDealFutureCf,uDealFutureScheduleCf                      )                         where import qualified Accounts as A@@ -39,6 +39,8 @@ import Revolving import Triggers +import Deal.DealCollection (CollectionRule(..))+ import qualified Data.Map as Map import qualified Data.Time as T import qualified Data.Set as S@@ -284,7 +286,7 @@                             ,bonds :: Map.Map BondName L.Bond                             ,pool ::  PoolType a                              ,waterfall :: Map.Map W.ActionWhen W.DistributionSeq-                            ,collects :: [W.CollectionRule]+                            ,collects :: [CollectionRule]                             ,stats :: (BalDealStatMap,RDealStatMap,BDealStatMap,IDealStatMap)                             ,liqProvider :: Maybe (Map.Map String CE.LiqFacility)                             ,rateSwap :: Maybe (Map.Map String HE.RateSwap)@@ -297,36 +299,23 @@  data UnderlyingDeal a = UnderlyingDeal {   deal :: TestDeal a-  ,futureCf :: CF.CashFlowFrame-  ,futureScheduleCf :: CF.CashFlowFrame+  ,futureCf :: Maybe CF.CashFlowFrame+  ,futureScheduleCf :: Maybe CF.CashFlowFrame   ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) } deriving (Generic,Eq,Ord,Show) -uDealFutureScheduleCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame+uDealFutureScheduleCf :: Ast.Asset a => Lens' (UnderlyingDeal a) (Maybe CF.CashFlowFrame) uDealFutureScheduleCf = lens getter setter   where      getter = futureScheduleCf     setter ud newCf = ud {futureScheduleCf = newCf} -uDealFutureCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame+uDealFutureCf :: Ast.Asset a => Lens' (UnderlyingDeal a) (Maybe CF.CashFlowFrame) uDealFutureCf = lens getter setter   where      getter = futureCf     setter ud newCf = ud {futureCf = newCf} -uDealFutureTxn :: Ast.Asset a => Lens' (UnderlyingDeal a) [CF.TsRow]-uDealFutureTxn = lens getter setter-  where -    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)@@ -517,48 +506,6 @@     getter = \case ResecDeal dm -> dm     setter (ResecDeal dm) newDm = ResecDeal newDm --- 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}    = case pt of@@ -620,7 +567,7 @@   let      mCf = case poolType of              MultiPool pm -> Map.map (view (P.poolFutureCf . _Just . _1 )) pm -- `debug` ("MultiPool" ++ show pm)-            ResecDeal uds -> Map.map futureCf uds+            ResecDeal uds -> Map.map (fromMaybe CF.emptyCashflow . futureCf) uds   in      case mPid of        Nothing -> mCf  -- `debug` ("Nothing when collecting cfs"++show mCf)

@@ -0,0 +1,89 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}++module Deal.DealCollection+  ( depositInflow+  , depositPoolFlow+  , readProceeds+  , extractTxnsFromFlowFrameMap+  , CollectionRule(..)+  ) where++import GHC.Generics++import Data.Aeson.TH+import Data.Aeson.Types++import qualified Accounts as A+import qualified Waterfall as W+import qualified Cashflow as CF+import qualified Data.Map as Map hiding (mapEither)++import Data.List+import Control.Monad+import Types+import Util+import Lib+import Control.Lens hiding (element)++data CollectionRule = Collect (Maybe [PoolId]) PoolSource AccountName                   -- ^ collect a pool source from pool collection and deposit to an account+                    | CollectByPct (Maybe [PoolId]) PoolSource [(Rate,AccountName)]     -- ^ collect a pool source from pool collection and deposit to multiple accounts with percentages+                    deriving (Show,Generic,Eq,Ord)+++readProceeds :: PoolSource -> CF.TsRow -> Either String Balance+readProceeds CollectedInterest x = return $ CF.mflowInterest x+readProceeds CollectedPrincipal x = return $ CF.mflowPrincipal x+readProceeds CollectedRecoveries x = return $ CF.mflowRecovery x+readProceeds CollectedPrepayment x = return $ CF.mflowPrepayment x+readProceeds CollectedRental  x    = return $ CF.mflowRental x+readProceeds CollectedPrepaymentPenalty x = return $ CF.mflowPrepaymentPenalty x+readProceeds CollectedCash x = return $ CF.tsTotalCash x+readProceeds CollectedFeePaid x = return $ 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.PoolCashflow -> [CF.TsRow]+extractTxnsFromFlowFrameMap mPids pflowMap = +  let +    extractTxns :: Map.Map PoolId CF.PoolCashflow -> [CF.TsRow]+    extractTxns m = concatMap (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 -> CollectionRule -> Map.Map PoolId CF.PoolCashflow -> Map.Map AccountName A.Account -> Either String (Map.Map AccountName A.Account)+depositInflow d (Collect mPids s an) pFlowMap amap +  = do +      amts <- traverse (readProceeds s) txns+      let amt = sum amts+      return $ Map.adjust (A.deposit amt d (PoolInflow mPids s)) an amap+    where +      txns =  extractTxnsFromFlowFrameMap mPids pFlowMap+++depositInflow d (CollectByPct mPids s splitRules) pFlowMap amap    --TODO need to check 100%+  = do +      amts <- traverse (readProceeds s) txns+      let amt = sum amts+      let amtsToAccs = [ (an, mulBR amt splitRate) | (splitRate, an) <- splitRules]+      return $ +              foldr+                (\(accName,accAmt) accM -> +                  Map.adjust (A.deposit accAmt d (PoolInflow mPids s)) accName accM)+                amap+                amtsToAccs+    where +      txns =  extractTxnsFromFlowFrameMap mPids pFlowMap +++-- ^ deposit cash to account by pool map CF and rules+depositPoolFlow :: [CollectionRule] -> Date -> Map.Map PoolId CF.PoolCashflow -> Map.Map String A.Account -> Either String (Map.Map String A.Account)+depositPoolFlow rules d pFlowMap amap +  = foldM (\acc rule -> depositInflow d rule pFlowMap acc) amap rules+++$(deriveJSON defaultOptions ''CollectionRule)

@@ -0,0 +1,745 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Deal.DealRun (+   run+   ,accrueRC+) where++import qualified Data.Set as S+import qualified Data.DList as DL+import Data.List+import Control.Lens hiding (element)+import Control.Lens.TH+import Control.Monad+import Data.Maybe+import Data.Either+import Data.Either.Utils+import Control.Monad.Loops (allM,anyM)++import qualified Asset as Ast+import qualified Cashflow as CF+import qualified Accounts as A+import qualified Data.Map as Map hiding (mapEither)+import qualified Waterfall as W+import qualified Liability as L+import qualified Reports as Rpt+import qualified Pool as P+import qualified Assumptions as AP+import qualified Hedge as HE+import qualified CreditEnhancement as CE+import qualified InterestRate as IR+import Triggers++import Deal.DealBase+import Deal.DealAction+import Deal.DealQuery+import Deal.DealCollection+import Revolving+import Hedge+import Stmt+import Types++import Util+import Lib+-- ^ execute effects of trigger: making changes to deal+-- TODO seems position of arugments can be changed : f :: a -> b -> m a  => f:: b -> a -> m a+runEffects :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent) -> Date -> TriggerEffect +           -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent)+runEffects (t@TestDeal{accounts = accMap, fees = feeMap ,status=st, bonds = bondMap, pool=pt+                      ,collects = collRules}, rc, actions, logs) d te+  = case te of +      DealStatusTo _ds -> return (t {status = _ds}, rc, actions, logs)+      DoAccrueFee fns -> do+                           newFeeList <- sequenceA $ calcDueFee t d  <$> (feeMap Map.!) <$> fns+                           let newFeeMap = Map.fromList (zip fns newFeeList) <> feeMap+                           return (t {fees = newFeeMap}, rc, actions, logs)+      ChangeReserveBalance accName rAmt ->+          return (t {accounts = Map.adjust (set A.accTypeLens (Just rAmt)) accName accMap }+                    , rc, actions, logs)+      +      TriggerEffects efs -> foldM (`runEffects` d) (t, rc, actions, logs) efs+      +      RunActions wActions -> do+                              (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 +          return (t' , rc, sortBy sortActionOnDate (newActions++actions), logs) ++      DoNothing -> return (t, rc, actions, DL.empty)+      _ -> Left $ "Date:"++ show d++" Failed to match trigger effects: "++show te++setBondStepUpRate :: Date -> [RateAssumption] -> L.Bond -> Either String L.Bond+setBondStepUpRate d ras b@(L.Bond _ _ _ ii (Just sp) _ _ _ _ _ _ _ _ _)+  = return $ +      let +        newII = L.stepUpInterestInfo sp ii+        newRate = AP.applyFloatRate ii d ras+      in +        (L.accrueInt d b) { L.bndInterestInfo = newII, L.bndRate = newRate }++setBondStepUpRate d ras b@(L.MultiIntBond bn _ _ iis (Just sps) _ _ _ _ _ _ _ _ _)+  = return $ +      let +        newIIs = zipWith L.stepUpInterestInfo sps iis+        newRates = (\x -> AP.applyFloatRate x d ras) <$> newIIs+      in +        (L.accrueInt d b) { L.bndInterestInfos = newIIs, L.bndRates = newRates }  -- `debug` (show d ++ ">> accure due to step up rate "++ bn)++setBondStepUpRate d ras bg@(L.BondGroup bMap pt)+  = do +      m <- mapM (setBondStepUpRate d ras) bMap+      return $ L.BondGroup m pt++-- ^ update bond interest rate from rate assumption+setBondNewRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond+setBondNewRate t d ras b@(L.Bond _ _ L.OriginalInfo{ L.originDate = od} ii _ bal currentRate _ dueInt _ Nothing _ _ _)+  = setBondNewRate t d ras b {L.bndDueIntDate = Just od}++-- ^ Floater rate+setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Floater br idx _spd rset dc mf mc) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _)+  = return $ (L.accrueInt d b){ L.bndRate = AP.applyFloatRate ii d ras }++-- ^ Fix rate, do nothing+setBondNewRate t d ras b@(L.Bond _ _ _ L.Fix {} _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _)+  = return b++-- ^ Ref rate+setBondNewRate t d ras b@(L.Bond _ _ _ (L.RefRate sr ds factor _) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) +  = do+      let b' = L.accrueInt d b+      rate <- queryCompound t d (patchDateToStats d ds)+      return b' {L.bndRate = fromRational (rate * toRational factor) }++-- ^ cap & floor & IoI+setBondNewRate t d ras b@(L.Bond _ _ _ ii _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) +  = return $ (L.accrueInt d b) { L.bndRate = AP.applyFloatRate ii d ras}++-- ^ bond group+setBondNewRate t d ras bg@(L.BondGroup bMap pt)+  = do +      m <- mapM (setBondNewRate t d ras) bMap+      return $ L.BondGroup m pt++-- ^ apply all rates for multi-int bond+setBondNewRate t d ras b@(L.MultiIntBond bn _ _ iis _ bal currentRates _ dueInts dueIoIs _ _ _ _)+  = let +      newRates = AP.applyFloatRate <$> iis <*> pure d <*> pure ras+      b' = L.accrueInt d b -- `debug` ("accrue due to new rate "++ bn)+    in+      return $ b' { L.bndRates = newRates } ++-- ^ accure rate cap +accrueRC :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> RateCap -> Either String RateCap+accrueRC t d rs rc@RateCap{rcNetCash = amt, rcStrikeRate = strike,rcIndex = index+                        ,rcStartDate = sd, rcEndDate = ed, rcNotional = notional+                        ,rcLastStlDate = mlsd+                        ,rcStmt = mstmt} +  | d > ed || d < sd = return rc +  | otherwise = do+                  r <- AP.lookupRate0 rs index d+                  balance <- case notional of+                               Fixed bal -> Right . toRational $ bal+                               Base ds -> queryCompound t d (patchDateToStats d ds)+                               Schedule ts -> return $ getValByDate ts Inc d++                  let accRate = max 0 $ r - fromRational (getValByDate strike Inc d) -- `debug` ("Rate from curve"++show (getValByDate strike Inc d))+                  let addAmt = case mlsd of +                                 Nothing -> IR.calcInt (fromRational balance) sd d accRate DC_ACT_365F+                                 Just lstD -> IR.calcInt (fromRational balance) lstD d accRate DC_ACT_365F++                  let newAmt = amt + addAmt  -- `debug` ("Accrue AMT"++ show addAmt)+                  let newStmt = appendStmt (IrsTxn d newAmt addAmt 0 0 0 SwapAccrue) mstmt +                  return $ rc { rcLastStlDate = Just d ,rcNetCash = newAmt, rcStmt = newStmt }++updateRateSwapBal :: Ast.Asset a => TestDeal a -> Date -> HE.RateSwap -> Either String HE.RateSwap+updateRateSwapBal t d rs@HE.RateSwap{ HE.rsNotional = base }+  =  case base of +        HE.Fixed _ -> return rs  +        HE.Schedule ts -> return $ rs { HE.rsRefBalance = fromRational (getValByDate ts Inc d) }+        HE.Base ds -> +            do +              v <- queryCompound t d (patchDateToStats d ds) +              return rs { HE.rsRefBalance = fromRational v} -- `debug` ("query Result"++ show (patchDateToStats d ds) )++updateRateSwapRate :: Ast.Asset a => TestDeal a -> Maybe [RateAssumption] -> Date -> HE.RateSwap -> Either String HE.RateSwap+updateRateSwapRate t Nothing _ _ = Left "Failed to update rate swap: No rate input assumption"+updateRateSwapRate t (Just rAssumps) d rs@HE.RateSwap{ HE.rsType = rt } +  = let +      getRate x = AP.lookupRate rAssumps x d+    in+      do  +        (pRate,rRate) <- case rt of +                              HE.FloatingToFloating flter1 flter2 ->+                                do +                                  r1 <- getRate flter1+                                  r2 <- getRate flter2+                                  return (r1, r2)+                              HE.FloatingToFixed flter r -> +                                do +                                  _r <- getRate flter+                                  return (_r, r)+                              HE.FixedToFloating r flter -> +                                do +                                  _r <- getRate flter+                                  return (r, _r)+                              HE.FormulaToFloating ds flter -> +                                do +                                  _r <- queryCompound t d (patchDateToStats d ds)+                                  r <- getRate flter+                                  return (fromRational _r, r)+                              HE.FloatingToFormula flter ds -> +                                do +                                  r <- getRate flter+                                  _r <- queryCompound t d (patchDateToStats d ds)+                                  return (r, fromRational _r)+        return rs {HE.rsPayingRate = pRate, HE.rsReceivingRate = rRate }++updateLiqProviderRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> CE.LiqFacility -> CE.LiqFacility+updateLiqProviderRate t d ras liq@CE.LiqFacility{CE.liqRateType = mRt, CE.liqPremiumRateType = mPrt+                                                , CE.liqRate = mr, CE.liqPremiumRate = mPr }+  = let +      newMr =  AP.evalFloaterRate d ras <$> mRt+      newMpr = AP.evalFloaterRate d ras <$> mPrt+      -- TODO probably need to accure int when interest rate changes ? +    in +      liq {CE.liqRate = newMr, CE.liqPremiumRate = newMpr }++runTriggers :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate]) -> Date -> DealCycle -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent)+runTriggers (t@TestDeal{status=oldStatus, triggers = Nothing},rc, actions) d dcycle = return (t, rc, actions, DL.empty)+runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc, actions) d dcycle = +  do+    let trgsMap = Map.findWithDefault Map.empty dcycle trgM+    let trgsToTest = Map.filter   +                           (\trg -> (not (trgStatus trg) || trgStatus trg && trgCurable trg))+                           trgsMap+    triggeredTrgs <- mapM (testTrigger t d) trgsToTest+    let triggeredEffects = [ trgEffects _trg | _trg <- Map.elems triggeredTrgs, (trgStatus _trg) ] +    (newDeal, newRc, newActions, logsFromTrigger) <- foldM (`runEffects` d) (t,rc,actions, DL.empty) triggeredEffects+    let newStatus = status newDeal +    let newLogs = DL.fromList [DealStatusChangeTo d oldStatus newStatus "By trigger"|  newStatus /= oldStatus] -- `debug` (">>"++show d++"trigger : new st"++ show newStatus++"old st"++show oldStatus)+    let newTriggers = Map.union triggeredTrgs trgsMap+    return (newDeal {triggers = Just (Map.insert dcycle newTriggers trgM)}+           , newRc+           , newActions+           , DL.append newLogs logsFromTrigger) -- `debug` ("New logs from trigger"++ show d ++">>>"++show newLogs)++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+      newPt = case pt of+                MultiPool poolM -> +                  MultiPool $+                    Map.foldrWithKey+                      (\k (CF.CashFlowFrame st txnCollected, mAssetFlow) acc ->+                        let +                          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 +                                             0 -> 0 +                                             _ ->  view CF.tsRowBalance $ last txnCollected+                          txnToAppend = CF.patchCumulative currentStats [] txnCollected+			  -- insert aggregated pool flow+                          accUpdated =  Map.adjust+			                  (\_v -> case (P.futureCf _v) of+					            Nothing -> set P.poolFutureCf (Just (CF.CashFlowFrame st txnCollected , Nothing)) _v+						    Just _ -> over (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (++ txnToAppend) _v+				          )+					  k+					  acc +			  -- 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 %~ (over (P.poolFutureCf . _Just . _2) appendFn)+                        in +                          Map.adjust +                            (over P.poolIssuanceStat (Map.insert RuntimeCurrentPoolBalance balInCollected))+                            k accUpdated') +                      poolM +                      poolInflowMap+                ResecDeal uds -> +                  ResecDeal $ +                    Map.foldrWithKey+                      (\k (CF.CashFlowFrame _ newTxns, _) acc->+                        Map.adjust (over uDealFutureCf (`CF.appendMCashFlow` newTxns)) k acc)+                      uds+		      poolInflowMap+    in +      t {pool = newPt}  --  `debug` ("after insert bal"++ show newPt)+++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 endedDate)} pCfM ads _ _ _ log  = return (t,DL.snoc log (EndRun 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+  | 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 +        return (finalDeal+                , DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving")+                , poolFlowMap)+  | otherwise+    = case ad of +        PoolCollection d _ ->+          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 +              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  +              -- 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}+                -- newScheduleFlowMap = Map.map (over CF.cashflowTxn (cutBy Exc Future d)) (fromMaybe Map.empty (getScheduledCashflow t Nothing))+                let newPt = case (pool dAfterDeposit) of +	  		      MultiPool pm -> MultiPool $+	                                          (over (mapped . P.poolFutureScheduleCf . _Just . _1 . CF.cashflowTxn) (cutBy Exc Future d)) pm +			      ResecDeal dMap -> ResecDeal $ +				                  (over (mapped . uDealFutureScheduleCf . _Just . CF.cashflowTxn) (cutBy Exc Future d)) dMap+                let runContext = RunContext outstandingFlow rAssump rates  -- `debug` ("PoolCollection: before rc >>"++ show d++">>>"++ show (pool dAfterDeposit))+		(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)+                (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 (increasePoolCollectedPeriod dRunWithTrigger1 )+                    (runPoolFlow rc3) +                    (Just ads3) +                    rates +                    calls +                    rAssump +                    (DL.concat [newLogs0,newLogs,eopActionsLog,newLogs1]) +          else+            run t poolFlowMap (Just ads) rates calls rAssump log ++        RunWaterfall d "" -> +          let+            runContext = RunContext poolFlowMap rAssump rates+            waterfallKey = if Map.member (W.DistributionDay dStatus) waterfallM then +                              W.DistributionDay dStatus+                            else +                              W.DefaultDistribution+                        +            waterfallToExe = Map.findWithDefault [] waterfallKey waterfallM+            callTest = fst $ fromMaybe ([]::[Pre],[]::[Pre]) calls+          in +            do +              (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) )+              if flag then+                do+                  let newStLogs = if null cleanUpActions then +                                    [DealStatusChangeTo d dStatus Called "Call by triggers before waterfall distribution"]+                                  else +                                    [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], 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))+                  (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 (increaseBondPaidPeriod dRunWithTrigger1)+                      (runPoolFlow rc3) +                      (Just ads2) +                      rates +                      calls +                      rAssump +                      (DL.concat [newLogsWaterfall, newLogs2 ,logsBeforeDist,DL.fromList [RunningWaterfall d waterfallKey]]) -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall 3>>"++ show (pool dRunWithTrigger1)++" status>>"++ show (status dRunWithTrigger1))++        -- Custom waterfall execution action from custom dates+        RunWaterfall d wName -> +          let+            runContext = RunContext poolFlowMap rAssump rates+            waterfallKey = W.CustomWaterfall wName+          in +            do+              waterfallToExe <- maybeToEither+                                  ("No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) $+                                  Map.lookup waterfallKey waterfallM+              let logsBeforeDist =[ WarningMsg (" No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) +                                        | Map.notMember waterfallKey waterfallM ]  +              (dAfterWaterfall, rc2, newLogsWaterfall) <- foldM (performActionWrap d) (t,runContext,log) waterfallToExe -- `debug` (show d ++ " running action"++ show waterfallToExe)+              run dAfterWaterfall (runPoolFlow rc2) (Just ads) rates calls rAssump +                  (DL.concat [newLogsWaterfall,DL.fromList (logsBeforeDist ++ [RunningWaterfall d waterfallKey])]) -- `debug` ("size of logs"++ show (length newLogsWaterfall)++ ">>"++ show d++ show (length logsBeforeDist))++        EarnAccInt d accName ->+          let +            newAcc = Map.adjust (A.depositInt d) accName accMap+          in +            run (t {accounts = newAcc}) poolFlowMap (Just ads) rates calls rAssump log++        AccrueFee d feeName -> +          do +            fToAcc <- maybeToEither +                        ("Failed to find fee "++feeName)+                        (Map.lookup feeName feeMap)+            newF <- calcDueFee t d fToAcc+            let newFeeMap = Map.fromList [(feeName,newF)] <> feeMap+            run (t{fees=newFeeMap}) poolFlowMap (Just ads) rates calls rAssump log++        ResetLiqProvider d liqName -> +          case liqProvider t of +            Nothing -> run t poolFlowMap (Just ads) rates calls rAssump log+            (Just mLiqProvider) +              -> let -- update credit +                   newLiqMap = Map.adjust (updateLiqProvider t d) liqName mLiqProvider+                 in+                   run (t{liqProvider = Just newLiqMap}) poolFlowMap (Just ads) rates calls rAssump log++        ResetLiqProviderRate d liqName -> +          case liqProvider t of +            Nothing -> run t poolFlowMap (Just ads) rates calls rAssump log+            (Just mLiqProvider) +              -> let -- update rate +                   newLiqMap = Map.adjust (updateLiqProviderRate t d (fromMaybe [] rates)) liqName mLiqProvider+                 in+                   run (t{liqProvider = Just newLiqMap}) poolFlowMap (Just ads) rates calls rAssump log+        +        DealClosed d ->+          let+            w = Map.findWithDefault [] W.OnClosingDay (waterfall t) +            rc = RunContext poolFlowMap rAssump rates  +            logForClosed =  [RunningWaterfall d W.OnClosingDay| not (null w)]+          in +            do+              newSt <- case dStatus of+                         (PreClosing st) -> return st+                         _ -> Left $ "DealClosed action is not in PreClosing status but got"++ show dStatus+              (newDeal, newRc, newLog) <- foldM (performActionWrap d) (t, rc, log) w  -- `debug` ("ClosingDay Action:"++show w)+              run newDeal{status=newSt} (runPoolFlow newRc) (Just ads) rates calls rAssump +                  (DL.concat [newLog, DL.fromList ([DealStatusChangeTo d (PreClosing newSt) newSt "By Deal Close"]++logForClosed)]) -- `debug` ("new st at closing"++ show newSt)++        ChangeDealStatusTo d s -> run (t{status=s}) poolFlowMap (Just ads) rates calls rAssump log++        CalcIRSwap d sn -> +          case rateSwap t of +            Nothing -> Left $ " No rate swaps modeled when looking for "++ sn+            Just rSwap ->+              do+                newRateSwap_rate <- adjustM (updateRateSwapRate t rates d) sn rSwap+                newRateSwap_bal <- adjustM (updateRateSwapBal t d) sn newRateSwap_rate +                let newRateSwap_acc = Map.adjust (HE.accrueIRS d) sn newRateSwap_bal+                run (t{rateSwap = Just newRateSwap_acc}) poolFlowMap (Just ads) rates calls rAssump log++        SettleIRSwap d sn -> +          case rateSwap t of +            Nothing -> Left $ " No rate swaps modeled when looking for "++ sn+            Just rSwap ->+              do+                acc <- case HE.rsSettleDates (rSwap Map.! sn) of +                          Nothing -> Left $ "No settle date found for "++ sn+                          Just (_, _accName) -> return $ accMap Map.! _accName+                let accBal = A.accBalance acc+                let rs = rSwap Map.! sn+                let settleAmt = HE.rsNetCash rs+                let accName = A.accName acc+                case (settleAmt <0, accBal < abs settleAmt) of +                  (True, True) ->+                    let+                      newAcc = Map.adjust (A.draw accBal d (SwapOutSettle sn)) accName accMap+                      newRsMap = Just $ Map.adjust (HE.payoutIRS d accBal) sn rSwap +                    in +                      run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump+                      $ DL.snoc log (WarningMsg $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn)+                    -- Left $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn+                  (True, False) -> +                    let+                      newAcc = Map.adjust (A.draw (abs settleAmt) d (SwapOutSettle sn)) accName  accMap+                      newRsMap = Just $ Map.adjust (HE.payoutIRS d settleAmt) sn rSwap +                    in +                      run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log+                  (False, _) -> +                    let +                      newAcc = Map.adjust (A.deposit settleAmt d (SwapInSettle sn)) accName accMap+                      newRsMap = Just $ Map.adjust (HE.receiveIRS d) sn rSwap +                    in+                      run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log++        AccrueCapRate d cn -> +          case rateCap t of +            Nothing -> Left $ " No rate cap found for "++ cn+            Just rCap ->+              let+                _rates = fromMaybe [] rates+              in +                do +                  newRateCap <- adjustM (accrueRC t d _rates) cn rCap+                  run (t{rateCap = Just newRateCap}) poolFlowMap (Just ads) rates calls rAssump log++        InspectDS d dss -> +          do+            newlog <- inspectListVars t d dss +            run t poolFlowMap (Just ads) rates calls rAssump $ DL.append log (DL.fromList newlog) -- `debug` ("Add log"++show newlog)+        +        ResetBondRate d bn  -> +          let +            rateList = fromMaybe [] rates+            bnd = bndMap Map.! bn+          in +            do +              newBnd <- setBondNewRate t d rateList bnd +              run t{bonds = Map.fromList [(bn,newBnd)] <> bndMap} poolFlowMap (Just ads) rates calls rAssump log+        +        StepUpBondRate d bn -> +          let +            bnd = bndMap Map.! bn -- `debug` ("StepUpBondRate--------------"++ show bn)+          in +            do +              newBndMap <- adjustM (setBondStepUpRate d (fromMaybe [] rates)) bn bndMap+              run t{bonds = newBndMap } poolFlowMap (Just ads) rates calls rAssump log+        +        ResetAccRate d accName -> +          do+            newAccMap <- adjustM +                          (\a@(A.Account _ _ (Just (A.InvestmentAccount idx spd dp dp1 lastDay _)) _ _)+                            -> do+                                 newRate <- AP.lookupRate (fromMaybe [] rates) (idx,spd) d +                                 let accWithNewInt = A.depositInt d a+                                 return accWithNewInt { A.accInterest = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)})+                          accName accMap+            run t{accounts = newAccMap} poolFlowMap (Just ads) rates calls rAssump log++        BuildReport sd ed ->+          let +            cashReport = Rpt.buildCashReport t sd ed +          in +            do +              bsReport <- Rpt.buildBalanceSheet t ed+              let newlog = FinancialReport sd ed bsReport cashReport+              run t poolFlowMap (Just ads) rates calls rAssump $ DL.snoc log newlog -- `debug` ("new log"++ show ed++ show newlog)++        FireTrigger d cyc n -> +          let +            triggerFired = case mTrgMap of +                               Nothing -> error "trigger is empty for override" +                               Just tm -> Map.adjust (Map.adjust (set trgStatusLens True) n) cyc tm+            triggerEffects = do+                                tm <- mTrgMap+                                cycM <- Map.lookup cyc tm+                                trg <- Map.lookup n cycM+                                return $ trgEffects trg+            +            runContext = RunContext poolFlowMap rAssump rates+          in +            do +              (newT, rc@(RunContext newPool _ _), adsFromTrigger, newLogsFromTrigger) +                <- case triggerEffects of +                    Nothing -> return (t, runContext, ads, DL.empty) -- `debug` "Nothing found on effects"+                    Just efs -> runEffects (t, runContext, ads, DL.empty) d efs+              let (oldStatus,newStatus) = (status t,status newT)+              let stChangeLogs = DL.fromList [DealStatusChangeTo d oldStatus newStatus "by Manual fireTrigger" |  oldStatus /= newStatus] +              run newT {triggers = Just triggerFired} newPool (Just ads) rates calls rAssump $ DL.concat [log,stChangeLogs,newLogsFromTrigger]+        +        MakeWhole d spd walTbl -> +            let +              schedulePoolFlowMap = case pt of +				      MultiPool pMap -> Map.map (view (P.poolFutureScheduleCf._Just._1) ) pMap +				      ResecDeal uDealMap -> Map.map (view (uDealFutureScheduleCf . _Just)) uDealMap+            in +              do +                factor <- liftA2+                            (/)+                            (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+                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 >)))))+                                 bondWal +                let bondPricingCurve = Map.map +                                         (\x -> IRateCurve [ TsPoint d x,TsPoint (getDate (last ads)) x] )+                                         bondSprd +                let bondPricingResult = Map.intersectionWithKey (\k v1 v2 -> L.priceBond d v2 v1) (bonds runDealWithSchedule) bondPricingCurve +                let depositBondFlow = Map.intersectionWith+                                        (\bnd (PriceResult pv _ _ _ _ _ _) -> +                                          let +                                            ostBal = L.getCurBalance bnd+                                            prinToPay = min pv ostBal+                                            intToPay = max 0 (pv - prinToPay)+                                            bnd1 = L.payPrin d prinToPay bnd+                                          in +                                            L.payYield d intToPay bnd1)+                                        (bonds t)+                                        bondPricingResult+                run t {bonds = depositBondFlow, status = Ended (Just d)} Map.empty (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call")+        +        FundBond d Nothing bName accName fundAmt ->+          let +            newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap+          in +            do+              let bndFunded = L.fundWith d fundAmt $ bndMap Map.! bName+              run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap}+                  poolFlowMap (Just ads) rates calls rAssump log++        FundBond d (Just p) bName accName fundAmt ->+          let +            newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap+          in +            do+              flag <- testPre d t p+              case flag of+                False -> run t poolFlowMap (Just ads) rates calls rAssump (DL.snoc log (WarningMsg ("Failed to fund bond"++ bName++ ":" ++show p)))+                True -> +                  do+                    let bndFunded = L.fundWith d fundAmt $ bndMap Map.! bName+                    run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap}+                        poolFlowMap (Just ads) rates calls rAssump log+          ++        IssueBond d Nothing bGroupName accName bnd mBal mRate -> +           run t poolFlowMap (Just ((IssueBond d (Just (Always True)) bGroupName accName bnd mBal mRate):ads)) rates calls rAssump log+        +        IssueBond d (Just p) bGroupName accName bnd mBal mRate ->+            do +              flag <- testPre d t p+              case flag of+                False -> run t poolFlowMap (Just ads) rates calls rAssump (DL.snoc log (WarningMsg ("Failed to issue to bond group"++ bGroupName++ ":" ++show p)))+                True -> let +                          newBndName = L.bndName bnd+                        in+                           do+                             newBalance <- case mBal of+                                             Just _q -> queryCompound t d (patchDateToStats d _q)  +                                             Nothing -> Right . toRational $ L.originBalance (L.bndOriginInfo bnd)+                             newRate <- case mRate of +                                         Just _q -> queryCompound t d (patchDateToStats d _q)+                                         Nothing -> return $ L.originRate (L.bndOriginInfo bnd)+                             let newBonds = case Map.lookup bGroupName bndMap of+                                              Nothing -> bndMap+                                              Just L.Bond {} -> bndMap+                                              Just (L.BondGroup bndGrpMap pt) -> let+                                                                                bndOInfo = (L.bndOriginInfo bnd) {L.originDate = d, L.originRate = newRate, L.originBalance = fromRational newBalance }+                                                                                bndToInsert = bnd {L.bndOriginInfo = bndOInfo,+                                                                                                   L.bndDueIntDate = Just d,+                                                                                                   L.bndLastIntPay = Just d, +                                                                                                   L.bndLastPrinPay = Just d,+                                                                                                   L.bndRate = fromRational newRate,+                                                                                                   L.bndBalance = fromRational newBalance}+                                                                              in +                                                                                Map.insert bGroupName +                                                                                           (L.BondGroup (Map.insert newBndName bndToInsert bndGrpMap) pt)+                                                                                           bndMap++                             let issuanceProceeds = fromRational newBalance+                             let newAcc = Map.adjust (A.deposit issuanceProceeds d (IssuanceProceeds newBndName))+                                                     accName+                                                     accMap+                             run t{bonds = newBonds, accounts = newAcc} poolFlowMap (Just ads) rates calls rAssump log+        RefiBondRate d accName bName iInfo ->+           let+             -- settle accrued interest +             -- TODO rebuild bond rate reset actions+             lstDate = getDate (last ads)+             isResetActionEvent (ResetBondRate _ bName ) = False +             isResetActionEvent _ = True+             filteredAds = filter isResetActionEvent ads+             newRate = L.getBeginRate iInfo+          in +             do +               nBnd <- calcDueInt t d $ bndMap Map.! bName+               let dueIntToPay = L.getTotalDueInt nBnd+               let ((shortfall,drawAmt),newAcc) = A.tryDraw dueIntToPay d (PayInt [bName]) (accMap Map.! accName)+               let newBnd = set L.bndIntLens iInfo $ L.payInt d drawAmt nBnd+               let resetDates = L.buildRateResetDates newBnd d lstDate +               -- let bResetActions = [ ResetBondRate d bName 0 | d <- resetDates ]+               -- TODO tobe fix+               let bResetActions = []+               let newAccMap = Map.insert accName newAcc accMap+               let newBndMap = Map.insert bName (newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d ,L.bndLastIntPay = Just d}) bndMap+               let newAds = sortBy sortActionOnDate $ filteredAds ++ bResetActions+               run t{bonds = newBndMap, accounts = newAccMap} poolFlowMap (Just newAds) rates calls rAssump log+           +        RefiBond d accName bnd -> Left "Undefined action: RefiBond"++        TestCall d ->+          let +            timeBasedTests::[Pre] = snd (fromMaybe ([],[]) calls)+          in+            do +              flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- timeBasedTests ]+              case any id flags of+                True -> +                  let +                     runContext = RunContext poolFlowMap rAssump rates+                     newStLogs = if null cleanUpActions then +                                   DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call"]+                                 else +                                   DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call", RunningWaterfall d W.CleanUp]+                  in  +                     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"), poolFlowMap) -- `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 -> 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+++        _ -> Left $ "Failed to match action on Date"++ show ad++       where+         cleanUpActions = Map.findWithDefault [] W.CleanUp (waterfall t) -- `debug` ("Running AD"++show(ad))+         remainCollectionNum = Map.elems $ Map.map (\(x,_) -> CF.sizeCashFlowFrame x ) poolFlowMap+         futureCashToCollectFlag = and $ Map.elems $ Map.map (\(pcf,_) -> all CF.isEmptyRow2 (view CF.cashflowTxn pcf)) poolFlowMap++-- 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 empty Nothing Nothing Nothing Nothing log+--   = do+--       (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 = return (t, log ,empty) -- `debug` ("End with pool CF is []")

@@ -25,6 +25,8 @@ import qualified Assumptions as AP import qualified InterestRate as IR +import Deal.DealCollection (CollectionRule(..))+ import Control.Lens hiding (element) import Control.Lens.TH @@ -301,23 +303,23 @@                   Nothing -> []                -- note fee is not tested-validateAggRule :: [W.CollectionRule] -> [PoolId] -> [ResultComponent]+validateAggRule :: [CollectionRule] -> [PoolId] -> [ResultComponent] validateAggRule rules validPids =     [ ErrorMsg ("Pool source "++show ps++" has a weight of "++show r)   | ((pid,ps),r) <- Map.toList oustandingPs ] ++     [ ErrorMsg ("Pool Id not found "++show ospid++" in "++ show validPids) | ospid <- osPid ]   where -    countWeight (W.Collect (Just pids) ps _) =  Map.fromList [((pid,ps),1.0) | pid <- pids]-    countWeight (W.Collect Nothing ps _) =  Map.fromList [((PoolConsol,ps),1.0)]-    countWeight (W.CollectByPct (Just pids) ps lst) = Map.fromList [((pid,ps), pct) | pid <- pids, pct <- fst <$> lst]-    countWeight (W.CollectByPct Nothing ps lst) = Map.fromList [((PoolConsol, ps),pct)| pct <- fst <$> lst]+    countWeight (Collect (Just pids) ps _) =  Map.fromList [((pid,ps),1.0) | pid <- pids]+    countWeight (Collect Nothing ps _) =  Map.fromList [((PoolConsol,ps),1.0)]+    countWeight (CollectByPct (Just pids) ps lst) = Map.fromList [((pid,ps), pct) | pid <- pids, pct <- fst <$> lst]+    countWeight (CollectByPct Nothing ps lst) = Map.fromList [((PoolConsol, ps),pct)| pct <- fst <$> lst]          sumMap = foldl1 (Map.unionWith (+)) $ countWeight <$> rules       oustandingPs = Map.filter (> 1.0) sumMap -    getPids (W.Collect (Just pids) _ _) = pids  -    getPids (W.Collect Nothing ps _) = [PoolConsol]-    getPids (W.CollectByPct (Just pids) _ _) = pids-    getPids (W.CollectByPct Nothing _ _ ) = [PoolConsol]+    getPids (Collect (Just pids) _ _) = pids  +    getPids (Collect Nothing ps _) = [PoolConsol]+    getPids (CollectByPct (Just pids) _ _) = pids+    getPids (CollectByPct Nothing _ _ ) = [PoolConsol]     osPid = Set.elems $ Set.difference (Set.fromList (concat (getPids <$> rules))) (Set.fromList validPids)  

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TupleSections #-}  module Pool (Pool(..),aggPool        ,getIssuanceField@@ -8,6 +9,7 @@        ,poolFutureScheduleCf        ,poolBegStats,calcLiquidationAmount,pricingPoolFlow        ,futureScheduleCfLens,futureCfLens, poolFutureCf+       ,runPool ) where  @@ -16,15 +18,19 @@            ,getIntervalDays,zipWith9,mkTs,periodsBetween            ,mkRateTs,daysBetween, ) +import Control.Parallel.Strategies import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) import qualified Assumptions as A import qualified Analytics as AN import qualified AssetClass.AssetBase as ACM +import AssetClass.Mortgage import AssetClass.AssetCashflow import Asset (Asset(..)) import qualified Data.Map as Map  import Data.Ratio+import qualified Data.Set as S+import Data.List import Data.Aeson hiding (json) import Language.Haskell.TH import GHC.Generics@@ -40,6 +46,7 @@ import Util import Cashflow (CashFlowFrame) import qualified Stmt as CF+import Stmt import Debug.Trace debug = flip trace @@ -190,7 +197,114 @@           in              AN.pv21 discountRate d futureDates futureCfCash + -- | run a pool of assets ,use asOfDate of Pool to cutoff cashflow yields from assets with assumptions supplied+runPool :: Asset a => Pool a -> Maybe A.ApplyAssumptionType -> Maybe [RateAssumption] +        -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)]+-- schedule cashflow just ignores the interest rate assumption+runPool (Pool [] (Just (cf,_)) _ asof _ _ ) Nothing _ = Right [(cf, Map.empty)]+-- schedule cashflow with stress assumption+runPool (Pool []  (Just (CF.CashFlowFrame _ txn,_)) _ asof _ (Just dp)) (Just (A.PoolLevel assumps)) mRates +  = sequenceA [ projCashflow (ACM.ScheduleMortgageFlow asof txn dp) asof assumps mRates ]++-- project contractual cashflow if nothing found in pool perf assumption+-- use interest rate assumption+runPool (Pool as _ _ asof _ _) Nothing mRates +  = do +      cf <- sequenceA $ parMap rdeepseq  (\x -> calcCashflow x asof mRates) as +      return [ (x, Map.empty) | x <- cf ]+-- asset cashflow with credit stress+---- By pool level+runPool (Pool as _ Nothing asof _ _) (Just (A.PoolLevel assumps)) mRates +  = sequenceA $ parMap rdeepseq (\x -> projCashflow x asof assumps mRates) as  +---- By index+runPool (Pool as _ Nothing  asof _ _) (Just (A.ByIndex idxAssumps)) mRates =+  let+    numAssets = length as+  in+    do +      _assumps <- traverse (A.lookupAssumptionByIdx idxAssumps) [0..(pred numAssets)] -- `debug` ("Num assets"++ show numAssets)+      sequenceA $ parMap rdeepseq (\(x, a) -> projCashflow x asof a mRates) (zip as _assumps)++---- By Obligor+runPool (Pool as _ Nothing asof _ _) (Just (A.ByObligor obligorRules)) mRates =+  let+    matchAssets []   _ [] = Right [(CF.CashFlowFrame (0,epocDate,Nothing) [], Map.empty)] +    matchAssets cfs [] [] = sequenceA cfs+    -- matchAssets cfs [] astList = sequenceA $ cfs ++ ((\x -> (\y -> (y, Map.empty)) <$> (Ast.calcCashflow x asof mRates)) <$> astList)+    matchAssets cfs [] astList = let+                                    poolCfs = parMap rdeepseq (\x -> calcCashflow x asof mRates) astList+                                    poolCfs' = (\x -> (, Map.empty) <$> x) <$> poolCfs+                                 in +                                    sequenceA $ cfs ++ poolCfs'+    matchAssets cfs (rule:rules) astList = +      case rule of +        A.ObligorById ids assetPerf +          -> let +               idSet = S.fromList ids+               (matchedAsts,unMatchedAsts) = partition +                                               (\x -> case getObligorId x of +                                                         Just oid -> S.member oid idSet+                                                         Nothing -> False) +                                               astList+               matchedCfs = parMap rdeepseq (\x -> projCashflow x asof assetPerf mRates) matchedAsts +             in +               matchAssets (cfs ++ matchedCfs) rules unMatchedAsts+        A.ObligorByTag tags tagRule assetPerf ->+          let +            obrTags = S.fromList tags++            matchRuleFn A.TagEq s1 s2 = s1 == s2 +            matchRuleFn A.TagSubset s1 s2 = s1 `S.isSubsetOf` s2+            matchRuleFn A.TagSuperset s1 s2 = s2 `S.isSubsetOf` s1+            matchRuleFn A.TagAny s1 s2 = not $ S.null $ S.intersection s1 s2+            matchRuleFn (A.TagNot tRule) s1 s2 = not $ matchRuleFn tRule s1 s2+            +            (matchedAsts,unMatchedAsts) = partition (\x -> matchRuleFn tagRule (getObligorTags x) obrTags) astList+            matchedCfs = parMap rdeepseq (\x -> projCashflow x asof assetPerf mRates) matchedAsts +          in +            matchAssets (cfs ++ matchedCfs) rules unMatchedAsts         +        A.ObligorByField fieldRules assetPerf -> +          let +            matchRuleFn (A.FieldIn fv fvals) Nothing = False+            matchRuleFn (A.FieldIn fv fvals) (Just fm) = case Map.lookup fv fm of+                                                    Just (Left v) -> v `elem` fvals+                                                    Nothing -> False+            matchRuleFn (A.FieldCmp fv cmp dv) (Just fm) = case Map.lookup fv fm of+                                                        Just (Right v) -> case cmp of +                                                                    G -> v > dv+                                                                    L -> v < dv+                                                                    GE -> v >= dv+                                                                    LE -> v <= dv+                                                        Nothing -> False+            matchRuleFn (A.FieldInRange fv rt dv1 dv2) (Just fm) = +              case Map.lookup fv fm of+                Just (Right v) -> case rt of +                          II -> v <= dv2 && v >= dv1+                          IE -> v <= dv2 && v > dv1+                          EI -> v < dv2 && v >= dv1+                          EE -> v < dv2 && v > dv1+                          _ -> False+                Nothing -> False+            matchRuleFn (A.FieldNot fRule) fm = not $ matchRuleFn fRule fm++            matchRulesFn fs fm = all (`matchRuleFn` fm) fs++            (matchedAsts,unMatchedAsts) = partition (matchRulesFn fieldRules . getObligorFields) astList            +            matchedCfs = parMap rdeepseq (\x -> projCashflow x asof assetPerf mRates) matchedAsts +         in +            matchAssets (cfs ++ matchedCfs) rules unMatchedAsts+        A.ObligorByDefault assetPerf ->+          matchAssets +            (cfs ++ (parMap rdeepseq (\x -> projCashflow x asof assetPerf mRates) astList))+            []+            []+  in+    matchAssets [] obligorRules as++-- safe net to catch other cases+runPool _a _b _c = Left $ "[Run Pool]: Failed to match" ++ show _a ++ show _b ++ show _c+   $(deriveJSON defaultOptions ''Pool)

@@ -13,7 +13,6 @@   ,getFlow,FlowDirection(..), aggByTxnComment,scaleByFactor   ,scaleTxn,isEmptyTxn, statementTxns, viewBalanceAsOf,filterTxn   ,HasStmt(..),Txn(..)-  ,getAllTxns,hasEmptyTxn   )   where 

@@ -14,7 +14,7 @@ import Lib  import Types import Accounts (ReserveAmount)-import Waterfall (Action,CollectionRule)+import Waterfall (Action) import Data.Aeson ( defaultOptions ) import Language.Haskell.TH import Data.Aeson.TH@@ -24,19 +24,17 @@ import Data.Map import GHC.Generics import Control.Lens--- import qualified Liability as L+import Deal.DealCollection (CollectionRule(..))  type TriggerName = String - data TriggerEffect = DealStatusTo DealStatus                           -- ^ change deal status                    | DoAccrueFee FeeNames                              -- ^ accure fee                    | AddTrigger Trigger                                -- ^ add a new trigger                    | ChangeReserveBalance String ReserveAmount         -- ^ update reserve target balance                      | CloseDeal (Int, DatePattern) (Int, DatePattern)                                (PricingMethod, AccountName, Maybe DealStats)   -                               (Maybe [CollectionRule])-                               -- ^ close the deal+                               (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

@@ -4,7 +4,7 @@ {-# LANGUAGE DeriveGeneric #-}  module Waterfall-  (PoolSource(..),Action(..),DistributionSeq(..),CollectionRule(..)+  (PoolSource(..),Action(..),DistributionSeq(..)   ,ActionWhen(..),BookType(..),ExtraSupport(..),PayOrderBy(..))   where @@ -45,7 +45,7 @@                 | ByMaturity                 | ByStartDate                 | ByCustomNames [String]-                -- | InverseSeq PayOrderBy+                | ReverseSeq PayOrderBy                 deriving (Show,Generic,Eq,Ord)  type BookLedger = (BookDirection, LedgerName) @@ -127,12 +127,7 @@  type DistributionSeq = [Action] -data CollectionRule = Collect (Maybe [PoolId]) PoolSource AccountName                   -- ^ collect a pool source from pool collection and deposit to an account-                    | CollectByPct (Maybe [PoolId]) PoolSource [(Rate,AccountName)]     -- ^ collect a pool source from pool collection and deposit to multiple accounts with percentages-                    deriving (Show,Generic,Eq,Ord)- $(deriveJSON defaultOptions ''BookType) $(deriveJSON defaultOptions ''ExtraSupport) $(deriveJSON defaultOptions ''PayOrderBy) $(deriveJSON defaultOptions ''Action)-$(deriveJSON defaultOptions ''CollectionRule)

@@ -25,7 +25,7 @@ import qualified Triggers as Trg import Lib import Types-+import Deal.DealCollection (CollectionRule(..)) import qualified Data.Map as Map import qualified Data.Time as T import qualified Data.Set as S@@ -104,8 +104,8 @@                                  (W.PayInt Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)    ])]- ,D.collects = [W.Collect Nothing W.CollectedInterest "General"-             ,W.Collect Nothing W.CollectedPrincipal "General"]+ ,D.collects = [Collect Nothing W.CollectedInterest "General"+             ,Collect Nothing W.CollectedPrincipal "General"]  ,D.liqProvider = Nothing  ,D.rateCap = Nothing  ,D.triggers = Nothing

@@ -25,6 +25,7 @@ import qualified Triggers as Trg import Lib import Types+import Deal.DealCollection (CollectionRule(..))  import qualified Data.Map as Map import qualified Data.Time as T@@ -89,9 +90,8 @@                                  (W.PayInt Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)    ])]- ,D.collects = [W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedInterest "General"-               ,W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedPrincipal "General"-             ]+ ,D.collects = [Collect (Just [PoolName "PoolA",PoolName "PoolB"]) CollectedInterest "General"+               ,Collect (Just [PoolName "PoolA",PoolName "PoolB"]) CollectedPrincipal "General"]  ,D.liqProvider = Nothing  ,D.rateCap = Nothing  ,D.triggers = Nothing

@@ -25,6 +25,7 @@ import qualified Triggers as Trg import Lib import Types+import Deal.DealCollection (CollectionRule(..))  import qualified Data.Map as Map import qualified Data.Time as T@@ -86,8 +87,8 @@                                  (W.PayInt Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)    ])]- ,D.collects = [W.Collect Nothing W.CollectedInterest "General"-             ,W.Collect Nothing W.CollectedPrincipal "General"]+ ,D.collects = [Collect Nothing W.CollectedInterest "General"+             ,Collect Nothing W.CollectedPrincipal "General"] }  resecDeal = D.TestDeal {@@ -121,11 +122,11 @@                          ]            )   ,D.pool = D.ResecDeal (Map.fromList [(DealBondFlow "base case" "A" (toDate "20200101") 0.25-                                        , D.UnderlyingDeal baseCase CF.emptyCashflow CF.emptyCashflow Nothing)])+                                        , D.UnderlyingDeal baseCase (Just CF.emptyCashflow) (Just CF.emptyCashflow) Nothing)])    ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [                                  (W.PayInt Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)    ])]- ,D.collects = [W.Collect Nothing W.CollectedInterest "General"-             ,W.Collect Nothing W.CollectedPrincipal "General"]+ ,D.collects = [Collect Nothing W.CollectedInterest "General"+             ,Collect Nothing W.CollectedPrincipal "General"] }

@@ -13,6 +13,7 @@ import qualified AssetClass.AssetBase as AB import qualified Expense as F import qualified Deal.DealBase as D+import Deal.DealCollection (CollectionRule(..)) import qualified Deal as DR import qualified Liability as L import qualified Waterfall as W@@ -87,9 +88,8 @@                                  (W.PayInt Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)    ])]- ,D.collects = [W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedInterest "General"-               ,W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedPrincipal "General"-             ]+ ,D.collects = [Collect (Just [PoolName "PoolA",PoolName "PoolB"]) CollectedInterest "General"+               ,Collect (Just [PoolName "PoolA",PoolName "PoolB"]) CollectedPrincipal "General"]  ,D.liqProvider = Nothing  ,D.rateCap = Nothing  ,D.triggers = Nothing@@ -108,10 +108,9 @@                                 24                                 AB.Current)]     rAssump = Just (AP.AvailableAssets (R.ConstantAsset $ AB.LO <$> poolAssets)-                                                (AP.PoolLevel ((AP.LoanAssump Nothing Nothing Nothing Nothing)+                                                (AP.PoolLevel (AP.LoanAssump Nothing Nothing Nothing Nothing                                                                 ,AP.DummyDelinqAssump-                                                                ,AP.DummyDefaultAssump))-                            )+                                                                ,AP.DummyDefaultAssump)))     inspectVars = [AP.InspectRpt MonthEnd [FutureCurrentPoolBalance Nothing                                           ,FutureCurrentPoolBalance (Just [PoolName "PoolA"])                                           ,FutureCurrentPoolBalance (Just [PoolName "PoolB"])@@ -130,7 +129,5 @@      ,testCase "empty pool flow" $      assertEqual "empty pool flow"      0-     -- (P.futureCf (D.pool baseCase))      0    ]-

@@ -641,11 +641,11 @@                       ,A.DummyDefaultAssump))      poolCf = fst . head $ -               case D.runPool pool assump1 Nothing of+               case P.runPool pool assump1 Nothing of                  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+                case P.runPool pool assump2 Nothing of                   Left _ -> undefined                   Right x -> x   in 

@@ -9,6 +9,7 @@  import qualified Accounts as A import qualified Stmt as Stmt+import Deal.DealCollection (CollectionRule(..)) import qualified Pool as P import qualified Asset as Ast import qualified AssetClass.Mortgage as ACM@@ -147,8 +148,8 @@                                  ,(W.PayInt Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)    ])]- ,D.collects = [W.Collect Nothing W.CollectedInterest "General"-             ,W.Collect Nothing W.CollectedPrincipal "General"]+ ,D.collects = [Collect Nothing W.CollectedInterest "General"+             ,Collect Nothing W.CollectedPrincipal "General"]  ,D.custom = Nothing  ,D.liqProvider = Just $ Map.fromList $                     [("Liq1",CE.LiqFacility @@ -259,7 +260,7 @@                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["B"] Nothing)    ])]- ,D.collects = [W.Collect Nothing W.CollectedCash "General"]+ ,D.collects = [Collect Nothing W.CollectedCash "General"]  ,D.custom = Nothing  ,D.liqProvider = Nothing   ,D.triggers = Nothing 

@@ -7,6 +7,7 @@ import Deal  import Deal.DealQuery (queryCompound)+import Deal.DealCollection (CollectionRule(..)) import qualified Accounts as A import qualified Stmt as S import qualified Pool as P@@ -130,7 +131,7 @@                                  ,(W.PayInt Nothing "General" ["A"] Nothing)                                  ,(W.PayPrin Nothing "General" ["A"] Nothing)    ])]- ,D.collects = [W.Collect Nothing W.CollectedCash "General"]+ ,D.collects = [Collect Nothing W.CollectedCash "General"]  ,D.custom = Nothing  ,D.liqProvider = Nothing  ,D.triggers = Nothing

@@ -9,7 +9,7 @@ import Types import Util import Stmt-import Deal (accrueRC)+import Deal.DealRun (accrueRC) import Data.Ratio  import UT.DealTest (td2) import Hedge (RateSwap(..),RateCap(..),RateSwapBase(..),rcNetCash)