appendStmt arg switch

src/Accounts.hs

@@ -84,15 +84,14 @@ accrueInt endDate a@(Account bal _ (Just interestType) _ stmt)
 depositInt :: Date -> Account -> Account
 depositInt _ a@(Account _ _ Nothing _ _) = a 
 depositInt ed a@(Account bal _ (Just intType) _ stmt)
-          = a {accBalance = newBal ,accStmt= newStmt ,accInterest = Just (newIntInfoType intType)}
+          = a {accBalance = newBal ,accStmt= appendStmt newTxn stmt ,accInterest = Just (newIntInfoType intType)}
           where 
             -- accruedInt = accrueInt a (mkTs [(lastCollectDate, toRational r),(ed, toRational r)])  ed
             accruedInt = accrueInt ed a
             newIntInfoType (BankAccount x y _d) = BankAccount x y ed
             newIntInfoType (InvestmentAccount x y z z1 _d z2) = (InvestmentAccount x y z z1 ed z2)
             newBal = accruedInt + bal  -- `debug` ("INT ACC->"++ show accrued_int)
             newTxn = AccTxn ed newBal accruedInt BankInt
-            newStmt = appendStmt stmt newTxn
 
 -- | move cash from account A to account B
 transfer :: (Account,Account) -> Date -> Amount -> (Account, Account)
@@ -104,16 +103,16 @@ transfer (sourceAcc@(Account sBal san _ _ sStmt), targetAcc@(Account tBal tan _
   where
     newSBal = sBal - amount
     newTBal = tBal + amount
-    sourceNewStmt = appendStmt sStmt (AccTxn d newSBal (- amount) (Transfer san tan))
-    targetNewStmt = appendStmt tStmt (AccTxn d newTBal amount (Transfer san tan) )
+    sourceNewStmt = appendStmt (AccTxn d newSBal (- amount) (Transfer san tan)) sStmt 
+    targetNewStmt = appendStmt (AccTxn d newTBal amount (Transfer san tan)) tStmt 
 
 -- | deposit cash to account with a comment
 deposit :: Amount -> Date -> TxnComment -> Account -> Account
 deposit amount d source acc@(Account bal _ _ _ maybeStmt)  =
     acc {accBalance = newBal, accStmt = newStmt}
   where
-    newBal = bal + amount -- `debug` ("Date:"++show d++ "deposit"++show amount++"from"++show bal)
-    newStmt = appendStmt maybeStmt (AccTxn d newBal amount source)
+    newBal = bal + amount
+    newStmt = appendStmt (AccTxn d newBal amount source) maybeStmt 
 
 -- | draw cash from account with a comment
 draw :: Amount -> Date -> TxnComment -> Account -> Account

src/Assumptions.hs

@@ -58,10 +58,10 @@ lookupAssumptionByIdx sbi i
 
 type ObligorTagStr = String
 
-data TagMatchRule = TagEq      -- ^ match exactly
+data TagMatchRule = TagEq                  -- ^ match exactly
                   | TagSubset
                   | TagSuperset
-                  | TagAny     -- ^ match any tag hit
+                  | TagAny                 -- ^ match any tag hit
                   | TagNot  TagMatchRule   -- ^ Negative match
                   deriving (Show, Generic, Read)
 
@@ -77,8 +77,8 @@ data ObligorStrategy = ObligorById [String] AssetPerf
                      | ObligorByDefault AssetPerf
                      deriving (Show, Generic, Read)
 
-data ApplyAssumptionType = PoolLevel AssetPerf -- ^ assumption apply to all assets in the pool
-                         | ByIndex [StratPerfByIdx] -- ^ assumption which only apply to a set of assets in the pool
+data ApplyAssumptionType = PoolLevel AssetPerf               -- ^ assumption apply to all assets in the pool
+                         | ByIndex [StratPerfByIdx]          -- ^ assumption which only apply to a set of assets in the pool
                          | ByName (Map.Map PoolId AssetPerf) -- ^ assumption for a named pool
                          | ByObligor [ObligorStrategy]
                          | ByPoolId (Map.Map PoolId ApplyAssumptionType) -- ^ assumption for a pool
@@ -194,12 +194,11 @@ type HistoryCash = Ts
 type CurrentHolding = Balance
 type PricingDate = Date
 
-
 data BondPricingInput = DiscountCurve PricingDate Ts                               -- ^ PV curve used to discount bond cashflow and a PV date where cashflow discounted to 
                       | RunZSpread Ts (Map.Map BondName (Date,Rational))    -- ^ PV curve as well as bond trading price with a deal used to calc Z - spread
                       -- | OASInput Date BondName Balance [Spread] (Map.Map String Ts)                        -- ^ only works in multiple assumption request 
                       | DiscountRate PricingDate Rate
-                      -- | IRRInput  (Map.Map BondName (HistoryCash,CurrentHolding,Maybe (Dates, PricingMethod)))        -- ^ IRR calculation for a list of bonds
+                      | IRRInput  (Map.Map BondName (HistoryCash,CurrentHolding,Maybe (Dates, PricingMethod)))        -- ^ IRR calculation for a list of bonds
                       deriving (Show,Generic)
 
 

src/CreditEnhancement.hs

@@ -7,7 +7,7 @@ module CreditEnhancement
   (LiqFacility(..),LiqSupportType(..),buildLiqResetAction,buildLiqRateResetAction
   ,LiquidityProviderName,draw,repay,accrueLiqProvider
   ,LiqDrawType(..),LiqRepayType(..),LiqCreditCalc(..)
-  ,consolStmt
+  ,consolStmt,CreditDefaultSwap(..)
   )
   where
 
@@ -133,17 +133,12 @@ draw  amt d liq@LiqFacility{ liqBalance = liqBal
                             ,liqDueInt = dueInt 
                             ,liqDuePremium = duePremium} 
   | isJust mCredit && (fromMaybe 0 mCredit) <= 0 = 
-    liq { liqStmt = appendStmt 
-                    mStmt $
-                    SupportTxn d mCredit liqBal dueInt duePremium 0 LiquidationDraw
-                    }
+    liq { liqStmt = appendStmt (SupportTxn d mCredit liqBal dueInt duePremium 0 LiquidationDraw) mStmt }
   | otherwise = liq { liqBalance = newBal,liqCredit = newCredit,liqStmt = newStmt}
     where 
         newCredit = (\x -> x - amt) <$> mCredit -- `debug` ("date "++ show d ++" insert orgin credit : "++show mCredit)
         newBal = liqBal + amt -- `debug` (show d ++"New bal"++ show liqBal ++ " "++ show amt++ "new credit: "++ show newCredit)
-        newStmt = appendStmt 
-                    mStmt $
-                    SupportTxn d newCredit  newBal dueInt duePremium (negate amt) LiquidationDraw
+        newStmt = appendStmt (SupportTxn d newCredit  newBal dueInt duePremium (negate amt) LiquidationDraw) mStmt
 
 
 repay :: Amount -> Date -> LiqRepayType -> LiqFacility -> LiqFacility
@@ -176,10 +171,7 @@ repay amt d pt liq@LiqFacility{liqBalance = liqBal
                     (Just IncludeBoth, LiqPremium) -> (+ amt) <$> mCredit
                     _ -> mCredit
 
-      newStmt = appendStmt mStmt $ 
-                           SupportTxn d newCredit newBal newIntDue newDuePremium amt $ 
-                           LiquidationRepay (show pt) -- `debug` ("date "++ show d ++" insert rpt type"++show pt)
-
+      newStmt = appendStmt (SupportTxn d newCredit newBal newIntDue newDuePremium amt  (LiquidationRepay (show pt))) mStmt  
 
 -- | accure fee and interest of a liquidity provider and update credit available
 accrueLiqProvider ::  Date -> LiqFacility -> LiqFacility
@@ -226,14 +218,7 @@ accrueLiqProvider d liq@(LiqFacility _ _ curBal mCredit mCreditType mRateType mP
                     Just IncludeDuePremium -> (\x -> x - accureFee) <$> mCredit
                     Just IncludeBoth -> (\x -> x - accureInt - accureFee) <$> mCredit
 
-      newStmt = appendStmt mStmt $ SupportTxn d 
-                                             newCredit
-                                             curBal
-                                             newDueInt 
-                                             newDueFee 
-                                             0
-                                             (LiquidationSupportInt accureInt accureFee)
-
+      newStmt = appendStmt (SupportTxn d newCredit curBal newDueInt newDueFee 0 (LiquidationSupportInt accureInt accureFee)) mStmt 
 
 
 instance QueryByComment LiqFacility where 
@@ -273,6 +258,38 @@ instance IR.UseRate LiqFacility where
   getIndex liq = head <$> IR.getIndexes liq
 
 
+data CDSType = CdsLifeCap Balance
+             | CdsLiftAttach Balance
+             deriving (Show, Generic, Eq, Ord)
+
+data CreditDefaultSwap = CDS {
+    cdsName :: String
+    ,cdsType :: CDSType
+
+    ,cdsInsure ::  DealStats     -- ^ the coverage 
+    ,cdsCollectAmt :: Balance    -- ^ the amount to collect from CDS
+    ,cdsCollectDate :: Maybe Date  -- ^last collect calculate date
+
+    ,cdsPremiumRefBalance :: DealStats  -- ^ how notional balance is calculated
+    ,cdsPremiumNotional :: Balance      -- ^ the balance to calculate premium
+
+    ,cdsRateType :: Maybe IR.RateType   -- ^ interest rate type 
+    ,cdsPremiumRate :: IRate            -- ^ the rate to calculate premium
+
+    ,cdsDuePremium :: Balance           -- ^ the due premium to payout from SPV
+    ,cdsDuePremiumDate :: Maybe Date    -- ^ last due premium calculate date
+
+    ,cdsLastCalcDate :: Maybe Date     -- ^ last calculate date on net cash 
+    ,cdsNetCash :: Balance            -- ^ the net cash to settle ,negative means SPV pay to CDS, positive means CDS pay to SPV
+
+    ,cdsStart :: Date
+    ,cdsEnds :: Maybe Date
+    ,cdsStmt :: Maybe Statement
+}  deriving (Show, Generic, Eq, Ord)
+
+
+
+
 $(deriveJSON defaultOptions ''LiqRepayType)
 $(deriveJSON defaultOptions ''LiqDrawType)
 $(deriveJSON defaultOptions ''LiqSupportType)

src/Deal.hs

@@ -266,7 +266,7 @@ accrueRC t d rs rc@RateCap{rcNetCash = amt, rcStrikeRate = strike,rcIndex = inde
                                  Just lstD -> calcInt (fromRational balance) lstD d accRate DC_ACT_365F
 
                   let newAmt = amt + addAmt  -- `debug` ("Accrue AMT"++ show addAmt)
-                  let newStmt = appendStmt mstmt $ IrsTxn d newAmt addAmt 0 0 0 SwapAccrue
+                  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
@@ -551,9 +551,8 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=
                           (\a@(A.Account _ _ (Just (A.InvestmentAccount idx spd dp dp1 lastDay _)) _ _)
                             -> let 
                                  newRate = AP.lookupRate (fromMaybe [] rates) (idx,spd) d 
-                                 newAccInt = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)
                                in 
-                                 a { A.accInterest = newAccInt}) 
+                                 a { A.accInterest = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)}) 
                           accName accMap
           in 
             run t{accounts = newAccMap} poolFlowMap (Just ads) rates calls rAssump log
@@ -744,11 +743,9 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=
 
 
 run t empty Nothing Nothing Nothing Nothing log
-  = 
-    do
+  = do
       (t, ads, pcf, unStressPcf) <- getInits t Nothing Nothing 
       run t pcf (Just ads) Nothing Nothing Nothing log  -- `debug` ("Init Done >>Last Action#"++show (length ads)++"F/L"++show (head ads)++show (last ads))
-
 
 run t empty _ _ _ _ log = Right (prepareDeal t,log) -- `debug` ("End with pool CF is []")
 
@@ -846,19 +843,15 @@ runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen  = opts
     = do 
         (newT, ads, pcf, unStressPcf) <- getInits t perfAssumps (Just nonPerfAssumps)  
         (finalDeal, logs) <- run (removePoolCf newT) 
-                                 pcf
-                                 (Just ads) 
-                                 mInterest
-                                 (readCallOptions <$> opts)
-                                 mRevolvingCtx
-                                 []  
+                                  pcf
+                                  (Just ads) 
+                                  mInterest
+                                  (readCallOptions <$> opts)
+                                  mRevolvingCtx
+                                  []  
         let poolFlowUsed = Map.map (fromMaybe (CF.CashFlowFrame (0,toDate "19000101",Nothing) [])) (getAllCollectedFrame finalDeal Nothing)  
         let poolFlowUsedNoEmpty = Map.map (over CF.cashflowTxn CF.dropTailEmptyTxns) poolFlowUsed  
-        -- bond pricing if any                            
-        let bndPricing = case mPricing of
-                           Nothing -> Nothing     
-                           Just _bpi -> Just (priceBonds finalDeal _bpi)  
-
+        let bndPricing = (priceBonds finalDeal) <$> mPricing
         return (finalDeal, Just poolFlowUsedNoEmpty, Just (getRunResult finalDeal ++ V.validateRun finalDeal ++logs), bndPricing) -- `debug` ("Run Deal end with")
     where
       (runFlag, valLogs) = V.validateReq t nonPerfAssumps 
@@ -872,6 +865,7 @@ runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen  = opts
       -- run() is a recusive function loop over all actions till deal end conditions are met
 
 -- | get bond principal and interest shortfalls from a deal
+-- TODO , what if bonds has funded during life time ? whatś the correct bond beg balance to be used ? 
 getRunResult :: Ast.Asset a => TestDeal a -> [ResultComponent]
 getRunResult t = os_bn_i ++ os_bn_b -- `debug` ("Done with get result")
   where 
@@ -982,8 +976,7 @@ populateDealDates (CurrentDates (lastCollect,lastPay) mRevolving end (nextCollec
 runPool :: Ast.Asset a => P.Pool a -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] 
         -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)]
 -- schedule cashflow just ignores the interest rate assumption
-runPool (P.Pool [] (Just cf) _ asof _ _ ) Nothing _ 
-  = Right $ [(cf, Map.empty)]
+runPool (P.Pool [] (Just cf) _ asof _ _ ) Nothing _ = Right $ [(cf, Map.empty)]
 -- schedule cashflow with stress assumption
 runPool (P.Pool [] (Just (CF.CashFlowFrame _ txn)) _ asof _ (Just dp)) (Just (AP.PoolLevel assumps)) mRates 
   = sequenceA [ Ast.projCashflow (ACM.ScheduleMortgageFlow asof txn dp) asof assumps mRates ] -- `debug` ("PROJ in schedule flow")
@@ -1089,7 +1082,7 @@ runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules))
 
 
 -- safe net to catch other cases
-runPool _a _b _c = error $ "Failed to match" ++ show _a ++ show _b ++ show _c
+runPool _a _b _c = Left $ "Failed to match" ++ show _a ++ show _b ++ show _c
 
 
 -- ^ patch issuance balance for PreClosing Deal

src/Deal/DealAction.hs

@@ -81,7 +81,7 @@ testTrigger t d trigger@Trigger{trgStatus=st,trgCurable=curable,trgCondition=con
                   do 
                     newSt <- newStM
                     return trigger { trgStatus = newSt
-                                    , trgStmt = Stmt.appendStmt tStmt (TrgTxn d newSt (Stmt.Tag memo))}
+                                    , trgStmt = Stmt.appendStmt (TrgTxn d newSt (Stmt.Tag memo)) tStmt }
 
 
 pricingAssets :: PricingMethod -> [(ACM.AssetUnion,AP.AssetPerf)] -> Maybe [RateAssumption] -> Date 

src/Expense.hs

@@ -67,7 +67,7 @@ payFee d amt f@(Fee fn ft fs fd fdDay fa flpd fstmt) =
    where
     [(r0,arrearRemain),(r1,dueRemain)] = paySeqLiabilities amt [fa,fd] -- `debug` ("AMT"++show amt++">> fa"++show fa++"fd"++show fd)
     paid = fa + fd - arrearRemain - dueRemain -- `debug` ("arrear remain "++show arrearRemain++"due remain "++ show dueRemain++"r0 r1"++show r0++show r1)
-    newStmt = appendStmt fstmt (ExpTxn d dueRemain paid arrearRemain (PayFee fn)) -- `debug` ("Actual paid to fee"++show paid)
+    newStmt = appendStmt (ExpTxn d dueRemain paid arrearRemain (PayFee fn)) fstmt
 
 -- | pay amount of fee regardless the due amount
 payResidualFee :: Date -> Amount -> Fee -> Fee
@@ -78,7 +78,7 @@ payResidualFee d amt f@(Fee fn ft fs fd fdDay fa flpd fstmt) =
      ,feeStmt = newStmt}
    where
     [(r0,arrearRemain),(r1,dueRemain)] = paySeqLiabilities amt [fa,fd] 
-    newStmt = appendStmt fstmt (ExpTxn d dueRemain amt arrearRemain (PayFee fn)) 
+    newStmt = appendStmt (ExpTxn d dueRemain amt arrearRemain (PayFee fn)) fstmt  
 
 -- | build accure dates for a fee
 buildFeeAccrueAction :: [Fee] -> Date -> [(String,Dates)] -> [(String,Dates)]

src/Hedge.hs

@@ -72,7 +72,7 @@ accrueIRS d rs@RateSwap{rsRefBalance = face
                       , rsReceivingRate = receiveRate     
                       , rsNetCash = netCash               
                       , rsStmt = stmt}                    
-  =  rs {rsNetCash = newNet , rsLastStlDate = Just d, rsStmt = newStmt }
+  =  rs {rsNetCash = newNet , rsLastStlDate = Just d, rsStmt = appendStmt newTxn stmt}
       where 
           accureStartDate =  case rsLastStlDate rs of 
                                Nothing ->  rsStartDate rs 
@@ -82,15 +82,12 @@ accrueIRS d rs@RateSwap{rsRefBalance = face
           newNetAmount = mulBIR (face * yearFactor) rateDiff  -- `debug` ("Diff rate"++ show rateDiff)
           newNet = netCash + newNetAmount
           newTxn = IrsTxn d face newNetAmount payRate receiveRate newNet SwapAccrue
-          newStmt = appendStmt stmt newTxn
 
 -- | set rate swap to state of receive all cash from counterparty
 receiveIRS :: Date -> RateSwap -> RateSwap 
 receiveIRS d rs@RateSwap{rsNetCash = receiveAmt, rsStmt = stmt} 
-  | receiveAmt > 0 = rs { rsNetCash = 0 ,rsStmt = newStmt}
+  | receiveAmt > 0 = rs { rsNetCash = 0 ,rsStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 SwapInSettle) stmt}
   | otherwise = rs
-     where 
-       newStmt = appendStmt stmt (IrsTxn d 0 receiveAmt 0 0 0 SwapInSettle)
 
 -- | set rate swap to state of payout all possible cash to counterparty
 payoutIRS :: Date -> Amount -> RateSwap -> RateSwap 
@@ -100,7 +97,7 @@ payoutIRS d amt rs@RateSwap{rsNetCash = payoutAmt, rsStmt = stmt}
      where 
        actualAmt = min amt (negate payoutAmt)  --TODO need to add a check here
        outstanding = payoutAmt + actualAmt
-       newStmt = appendStmt stmt $ IrsTxn d 0 actualAmt 0 0 0 SwapOutSettle
+       newStmt = appendStmt (IrsTxn d 0 actualAmt 0 0 0 SwapOutSettle) stmt 
 
 instance QueryByComment RateSwap where 
     queryStmt RateSwap{rsStmt = Nothing} tc = []
@@ -132,7 +129,7 @@ receiveRC d rc@RateCap{rcNetCash = receiveAmt, rcStmt = stmt}
   | receiveAmt > 0 = rc { rcNetCash = 0 ,rcStmt = newStmt}
   | otherwise = rc
      where 
-       newStmt = appendStmt stmt (IrsTxn d 0 receiveAmt 0 0 0 SwapInSettle)
+       newStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 SwapInSettle) stmt 
 
 instance IR.UseRate RateCap where 
   getIndexes rc@RateCap{rcIndex = idx} = Just [idx]
@@ -218,25 +215,6 @@ buildSrtResetAction (srt:srts) ed r =
         [(ln,IR.getRateResetDates sd ed (Just rt))]++r
     _ -> buildSrtResetAction srts ed r
 
-data CreditDefaultSwap = CDS {
-    cdsName :: String
-
-    ,cdsInsure ::  DealStats
-    ,cdsCollectAmt :: Balance
-    ,cdsCollectDate :: Maybe Date
-
-    ,cdsPremiumRefBalance :: DealStats
-    ,cdsPremiumRate :: IRate
-    ,cdsDuePremium :: Balance
-    ,cdsDuePremiumDate :: Maybe Date
-
-    ,cdsLastCalcDate :: Maybe Date
-    ,cdsNetCash :: Balance
-
-    ,cdsStart :: Date
-    ,cdsEnds :: Maybe Date
-    ,cdsStmt :: Maybe Statement
-}  deriving (Show, Generic, Eq, Ord)
 
 
 

src/Ledger.hs

@@ -38,12 +38,12 @@ entryLog amt d cmt ledg@Ledger{ledgStmt = mStmt, ledgBalance = bal}
                                    newBal = bal - amt
                                    txn = EntryTxn d newBal amt cmt
                                  in 
-                                   ledg { ledgStmt = appendStmt mStmt txn ,ledgBalance = newBal }
+                                   ledg { ledgStmt = appendStmt txn mStmt,ledgBalance = newBal }
   | otherwise = let 
                   newBal = bal + amt
                   txn = EntryTxn d newBal amt cmt
                 in 
-                  ledg { ledgStmt = appendStmt mStmt txn ,ledgBalance = newBal }
+                  ledg { ledgStmt = appendStmt txn mStmt ,ledgBalance = newBal }
 
 -- TODO-- need to ensure there is no direction in input
 entryLogByDr :: BookDirection -> Amount -> Date -> Maybe TxnComment -> Ledger -> Ledger