Dec 25 : Release

shell.nix

@@ -5,6 +5,7 @@ pkgs.mkShell {
     cabal2nix
     haskell.compiler.ghc912
     haskell-language-server
+    python313Packages.towncrier
     ghciwatch
     just
   ];

src/Accounts.hs

@@ -52,14 +52,14 @@ data ReserveAmount
 
 data Account = Account {
     accBalance :: Balance                 -- ^ account current balance
-    ,accName :: String                    -- ^ account name
+    ,accName :: AccountName               -- ^ account name
     ,accInterest :: Maybe InterestInfo    -- ^ account reinvestment interest
     ,accType :: Maybe ReserveAmount       -- ^ target info if a reserve account
     ,accStmt :: Maybe Statement           -- ^ transactional history
 } deriving (Show, Generic, Eq, Ord)
 
 -- | build interest earn actions
-buildEarnIntAction :: [Account] -> Date -> [(String,Dates)] -> [(String,Dates)]
+buildEarnIntAction :: [Account] -> Date -> [(AccountName,Dates)] -> [(AccountName,Dates)]
 buildEarnIntAction [] ed r = r
 buildEarnIntAction (acc:accs) ed r = 
   case accInterest acc of 
@@ -69,6 +69,8 @@ buildEarnIntAction (acc:accs) ed r =
     Just (InvestmentAccount _ _ dp _ lastAccDate _) 
       -> buildEarnIntAction accs ed [(accName acc, genSerialDatesTill2 NO_IE lastAccDate dp ed)]++r    
 
+
+-- | accrue interest from last reset date to today
 accrueInt :: Date -> Account -> Balance
 accrueInt _ (Account _ _ Nothing _ _) = 0 
 -- ^ bank account type interest 

src/Asset.hs

@@ -157,11 +157,15 @@ applyExtraStress Nothing _ ppy def = (ppy,def)
 applyExtraStress (Just ExtraStress{A.defaultFactors= mDefFactor
                                   ,A.prepaymentFactors = mPrepayFactor}) ds ppy def =
   case (mPrepayFactor,mDefFactor) of
-    (Nothing,Nothing) -> (ppy,def)
-    (Nothing,Just defFactor) -> (ppy ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor)
-    (Just ppyFactor,Nothing) -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor, def)
-    (Just ppyFactor,Just defFactor) -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor
-                                       ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor)
+    (Nothing,Nothing) 
+      -> (ppy,def)
+    (Nothing,Just defFactor) 
+      -> (ppy ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor)
+    (Just ppyFactor,Nothing) 
+      -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor, def)
+    (Just ppyFactor,Just defFactor) 
+      -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor
+          ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor)
 
 -- ^ convert annual CPR to single month mortality
 cpr2smm :: Rate -> Rate

src/Call.hs

@@ -14,16 +14,27 @@ import Data.Aeson.TH
 import Data.Aeson.Types
 import GHC.Generics
 
-data CallOption = PoolBalance Balance    -- ^ triggered when pool perform balance below threshold
-                | BondBalance Balance    -- ^ triggered when bond current balance below threshold
-                | PoolFactor Rate        -- ^ triggered when pool factor (pool perform balance/origin balance)
-                | BondFactor Rate        -- ^ triggered when bond factor (total bonds current balance / origin balance)
-                | OnDate Date            -- ^ triggered at date
-                | AfterDate Date         -- ^ triggered when after date
-                | And [CallOption]       -- ^ triggered when all options were satisfied
-                | Or [CallOption]        -- ^ triggered when any option is satisfied
-                | PoolPv Balance         -- ^ Call when PV of pool fall below
-                | Pre Pre                -- ^ triggered when predicate evaluates to be True
-                deriving (Show,Generic,Ord,Eq,Read)
+data CallOption 
+    -- | triggered when pool perform balance below threshold
+    = PoolBalance Balance    
+    -- | triggered when bond current balance below threshold
+    | BondBalance Balance    
+    -- | triggered when pool factor (pool perform balance/origin balance)
+    | PoolFactor Rate        
+    -- | triggered when bond factor (total bonds current balance / origin balance)
+    | BondFactor Rate        
+    -- | triggered at date
+    | OnDate Date            
+    -- | triggered when after date
+    | AfterDate Date         
+    -- | triggered when all options were satisfied
+    | And [CallOption]       
+    -- | triggered when any option is satisfied
+    | Or [CallOption]        
+    -- | Call when PV of pool fall below
+    | PoolPv Balance         
+    -- | triggered when predicate evaluates to be True
+    | Pre Pre                
+    deriving (Show,Generic,Ord,Eq,Read)
 
 $(deriveJSON defaultOptions ''CallOption)

src/Cashflow.hs

@@ -110,7 +110,6 @@ type NewDepreciation = Balance
 type AccuredFee = Balance
 type FeePaid = Balance
 
-startOfTime = T.fromGregorian 1900 1 1
 
 data TsRow = CashFlow Date Amount
            | BondFlow Date Balance Principal Interest
@@ -120,7 +119,6 @@ data TsRow = CashFlow Date Amount
            | LeaseFlow Date Balance Rental Default
            | FixedFlow Date Balance NewDepreciation Depreciation Balance Balance -- unit cash 
            | ReceivableFlow Date Balance AccuredFee Principal FeePaid Default Recovery Loss (Maybe CumulativeStat) 
-	   -- | MixedCashflow Date Balance Principal Interest Prepayment 
            deriving(Show,Eq,Ord,Generic,NFData)
 
 instance Semigroup TsRow where 

src/Deal/DealAction.hs

@@ -468,7 +468,9 @@ drawExtraSupport d amt (W.SupportAccount an (Just (dr, ln))) t@TestDeal{accounts
       let drawAmt = min (A.accBalance acc) amt
       let oustandingAmt = amt - drawAmt
       newAccMap <- adjustM (A.draw d drawAmt Types.SupportDraw) an accMap
-      return (t {accounts = newAccMap ,ledgers = Just $ Map.adjust (LD.entryLog drawAmt d (TxnDirection dr)) ln ledgerMap} , oustandingAmt)
+      return (t {accounts = newAccMap 
+                ,ledgers = Just $ Map.adjust (LD.entryLogByDr (dr,drawAmt) d Nothing) ln ledgerMap} 
+              , oustandingAmt)
 
 -- ^ draw account support
 drawExtraSupport d amt (W.SupportAccount an Nothing) t@TestDeal{accounts=accMap} 
@@ -790,7 +792,7 @@ performAction d t@TestDeal{accounts=accMap, ledgers = Just ledgerM}
       targetAcc <- lookupM an2 accMap
       (transferAmt,accDrawAmt,_) <- calcAvailAfterLimit t d sourceAcc Nothing (A.accBalance sourceAcc) mLimit
       (sourceAcc', targetAcc') <- A.transfer (sourceAcc,targetAcc) d transferAmt 
-      let newLedgerM = Map.adjust (LD.entryLog transferAmt d (TxnDirection dr)) lName ledgerM
+      let newLedgerM = Map.adjust (LD.entryLogByDr (dr, transferAmt) d Nothing) lName ledgerM
       return t {accounts = Map.insert an1 sourceAcc' (Map.insert an2 targetAcc' accMap)
                , ledgers = Just newLedgerM}  
 
@@ -815,13 +817,13 @@ performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.Till ledger dr ds
     targetAmt <- queryCompound t d ds
     ledgerI <- lookupM ledger ledgerM
     let (bookDirection, amtToBook) = LD.bookToTarget ledgerI (dr, fromRational targetAmt)
-    let newLedgerM = Map.adjust (LD.entryLogByDr bookDirection amtToBook d Nothing) ledger ledgerM
+    let newLedgerM = Map.adjust (LD.entryLogByDr (bookDirection,amtToBook) d Nothing) ledger ledgerM
     return $ t {ledgers = Just newLedgerM } 
 
 performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.ByDS ledger dr ds)) =
   do
     amtToBook <- queryCompound t d ds
-    let newLedgerM = Map.adjust (LD.entryLogByDr dr (fromRational amtToBook) d Nothing) ledger ledgerM
+    let newLedgerM = Map.adjust (LD.entryLogByDr (dr,(fromRational amtToBook)) d Nothing) ledger ledgerM
     return $ t {ledgers = Just newLedgerM } 
 
 -- ^ it will book ledgers by order with mandatory caps which describes by a <formula> 
@@ -836,7 +838,7 @@ performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.PDL dr ds ledgers
       ledgCaps <- sequenceA [ queryCompound t d ledgerCap | ledgerCap <- snd <$> ledgersList ]
       let amtBookedToLedgers = paySeqLiabilitiesAmt (fromRational amtToBook) (fromRational <$> ledgCaps) 
       let newLedgerM = foldr 
-                         (\(ln,amt) acc -> Map.adjust (LD.entryLogByDr dr amt d Nothing) ln acc)
+                         (\(ln,amt) acc -> Map.adjust (LD.entryLogByDr (dr,amt) d Nothing) ln acc)
                          ledgerM
                          (zip ledgerNames amtBookedToLedgers) --`debug` ("amts to book"++ show amtBookedToLedgers)
       return $ t {ledgers = Just newLedgerM}
@@ -965,7 +967,7 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap,ledgers= Just ledgerM}
         let totalDue = sum dueAmts
         (paidOutAmt,accPaidOut,supportPaidOut) <- calcAvailAfterLimit t d acc mSupport totalDue mLimit
         (bondsPaid,_) <- payProM d paidOutAmt qFn (pay d q) bndsList
-        let newLedgerM = Map.adjust (LD.entryLogByDr dr paidOutAmt d Nothing) lName ledgerM
+        let newLedgerM = Map.adjust (LD.entryLogByDr (dr,paidOutAmt) d Nothing) lName ledgerM
         newAccMap <- adjustM (A.draw d accPaidOut (PayInt bnds)) an accMap
 
         let dealAfterAcc = t {accounts = newAccMap
@@ -1194,7 +1196,7 @@ performAction d t@TestDeal{bonds = bndMap, ledgers = Just ledgerM }
       bndToWriteOff <- lookupM bnd bndMap
       let bndBal = L.bndBalance bndToWriteOff
       writeAmt <- applyLimit t d bndBal bndBal mLimit
-      let newLedgerM = Map.adjust (LD.entryLogByDr dr writeAmt d (Just (WriteOff bnd writeAmt))) lName ledgerM
+      let newLedgerM = Map.adjust (LD.entryLogByDr (dr,writeAmt) d (Just (WriteOff bnd writeAmt))) lName ledgerM
       bndWritedOff <- writeOff d DuePrincipal writeAmt bndToWriteOff
       return $ t {bonds = Map.fromList [(bnd,bndWritedOff)] <> bndMap, ledgers = Just newLedgerM}
 
@@ -1220,7 +1222,7 @@ performAction d t@TestDeal{bonds=bndMap, ledgers = Just ledgerM}
       writeAmt <- applyLimit t d totalBondBal totalBondBal mLimit
       (bndWrited, _) <- paySeqM d writeAmt L.bndBalance (writeOff d DuePrincipal) (Right []) bndsToWriteOff 
       let bndMapUpdated = lstToMapByFn L.bndName bndWrited
-      let newLedgerM = Map.adjust (LD.entryLogByDr dr writeAmt d Nothing) lName ledgerM
+      let newLedgerM = Map.adjust (LD.entryLogByDr (dr,writeAmt) d Nothing) lName ledgerM
       return t {bonds = bndMapUpdated <> bndMap, ledgers = Just newLedgerM}
 
 

src/Deal/DealCollection.hs

@@ -26,9 +26,12 @@ 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)
+data CollectionRule
+    -- | collect a pool source from pool collection and deposit to an account
+    = Collect (Maybe [PoolId]) PoolSource AccountName
+    -- | collect a pool source from pool collection and deposit to multiple accounts with percentages                   
+    | CollectByPct (Maybe [PoolId]) PoolSource [(Rate,AccountName)]     
+    deriving (Show,Generic,Eq,Ord)
 
 
 readProceeds :: PoolSource -> CF.TsRow -> Either ErrorRep Balance
@@ -55,7 +58,7 @@ extractTxnsFromFlowFrameMap mPids 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 :: Date -> CollectionRule -> Map.Map PoolId CF.PoolCashflow -> Map.Map AccountName A.Account -> Either ErrorRep (Map.Map AccountName A.Account)
 depositInflow d (Collect mPids s an) pFlowMap amap 
   = do 
       amts <- traverse (readProceeds s) txns
@@ -81,7 +84,7 @@ depositInflow d (CollectByPct mPids s splitRules) pFlowMap amap    --TODO need t
 
 
 -- ^ 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 :: [CollectionRule] -> Date -> Map.Map PoolId CF.PoolCashflow -> Map.Map String A.Account -> Either ErrorRep (Map.Map String A.Account)
 depositPoolFlow rules d pFlowMap amap 
   = foldM (\acc rule -> depositInflow d rule pFlowMap acc) amap rules
 

src/Deal/DealQuery.hs

@@ -405,7 +405,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f
         Nothing -> Left ("Date:"++show d++"No ledgers were modeled , failed to find ledger:"++show ans )
         Just ledgersM -> 
           do 
-            lgBals <- lookupAndApplies LD.ledgBalance "Ledger Balance" ans ledgersM
+            lgBals <- lookupAndApplies (snd . LD.ledgBalance) "Ledger Balance" ans ledgersM
             return $ (toRational . sum) lgBals
 
     LedgerBalanceBy dr ans ->
@@ -415,9 +415,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f
           do 
             lgdsM <- selectInMap "Look up ledgers" ans ledgersM
             let ldgL = Map.elems lgdsM
-            let bs Credit = filter (\x -> LD.ledgBalance x < 0) ldgL
-            let bs Debit = filter (\x -> LD.ledgBalance x >= 0) ldgL
-            return $ toRational $ abs $ sum $ LD.ledgBalance <$> bs dr
+            return $ toRational  $ sum $ (snd . LD.ledgBalance) <$> ldgL
 
     FutureCurrentPoolBalance mPns ->
       case (mPns,pt) of 
@@ -643,7 +641,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f
           in
             case mCmt of
               Just cmt -> Right . toRational $ sum [ queryTxnAmt lg cmt | lg <- lgs ]
-              Nothing -> Right . toRational $ sum [ LD.ledgBalance lg | lg <- lgs ]
+              Nothing -> Right . toRational $ sum [ (snd . LD.ledgBalance) lg | lg <- lgs ]
 
     BondBalanceGapAt d bName -> 
       queryCompound t d (Excess [CurrentBondBalanceOf [bName], BondBalanceTarget [bName]])
@@ -817,7 +815,7 @@ queryDealBool t@TestDeal{triggers= trgs,bonds = bndMap,fees= feeMap
                          Just triggerMatCycle -> 
                            case Map.lookup tName triggerMatCycle of 
                              Nothing -> Left ("Date:"++show d++"no trigger for this deal" ++ show tName ++ " in cycle " ++ show triggerMatCycle)
-                             Just trigger -> Right $ Trg.trgStatus trigger 
+                             Just trigger -> return $ Trg.trgStatus trigger 
         Nothing -> Left $ "Date:"++show d++"no trigger for this deal"
 
     IsMostSenior bn bns ->
@@ -882,7 +880,6 @@ queryDealBool t@TestDeal{triggers= trgs,bonds = bndMap,fees= feeMap
 
 
     TestNot ds -> do not <$> (queryDealBool t ds d)
-    -- TestAny b dss -> b `elem` [ queryDealBool t ds d | ds <- dss ]
     TestAny b dss -> anyM (\ x -> (== b) <$> queryDealBool t x d ) dss
     TestAll b dss -> allM (\ x -> (== b) <$> queryDealBool t x d ) dss
 
@@ -968,9 +965,9 @@ testPre d t p =
                           q1 <- (queryCompound t d (ps s1))
                           q2 <- (queryCompound t d (ps s2))
                           return (toCmp cmp q1 q2)  
-    IfDealStatus st -> Right $ status t == st   --  `debug` ("current date"++show d++">> stutus"++show (status t )++"=="++show st)
+    IfDealStatus st -> return $ status t == st   --  `debug` ("current date"++show d++">> stutus"++show (status t )++"=="++show st)
 
-    Always b -> Right b
+    Always b -> return b
     IfNot _p -> not <$> testPre d t _p
     where 
       toCmp x = case x of 
@@ -1027,5 +1024,5 @@ preToStr t d p =
   where 
     ps = patchDateToStats d
 
-testPre2 :: P.Asset a => Date -> TestDeal a -> Pre -> (String, Either String Bool)
+testPre2 :: P.Asset a => Date -> TestDeal a -> Pre -> (String, Either ErrorRep Bool)
 testPre2 d t p = (preToStr t d p, testPre d t p)

src/Deal/DealRun.hs

@@ -311,15 +311,19 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=
                                           poolFlowMap 
               collectedFlow =  Map.map (bimap fst ((\xs -> [ fst x | x <- xs ]) <$>)) cutOffPoolFlowMap  
               outstandingFlow = Map.map (bimap snd ((\xs -> [ snd x | x <- xs ]) <$>)) cutOffPoolFlowMap  
-
+              cutFutureCf = cutBy Exc Future d
               -- deposit cashflow to SPV from external pool cf               
             in 
               do 
+                -- depsoit collected cashflow to accounts
                 accs <- depositPoolFlow (collects t) d collectedFlow accMap 
+                -- new deal = update accounts and pool collected cashflow
                 let dAfterDeposit = (appendCollectedCF d t collectedFlow) {accounts=accs}
                 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
+                              MultiPool pm -> 
+                                MultiPool $ (over (mapped . P.poolFutureScheduleCf . _Just . _1 . CF.cashflowTxn) cutFutureCf) pm 
+                              ResecDeal dMap -> 
+                                ResecDeal $ (over (mapped . uDealFutureScheduleCf . _Just . CF.cashflowTxn) cutFutureCf) dMap
                 let runContext = RunContext outstandingFlow rAssump rates  
                 (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 ] 
@@ -592,8 +596,6 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=
                                            ostBal = L.getCurBalance bnd
                                            prinToPay = min pv ostBal
                                            intToPay = max 0 (pv - prinToPay)
-                                           -- bnd1 = L.payPrin d prinToPay bnd
-                                           -- bnd1 = L.payYield d intToPay bnd 
                                          in 
                                            (pay d DuePrincipal prinToPay) =<< (pay d DueResidual intToPay bnd))
                                        bndMap
@@ -698,7 +700,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=
                   let 
                     runContext = RunContext poolFlowMap rAssump rates
                     newStLogs 
-		              | null cleanUpActions = DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call"]
+		                  | null cleanUpActions = DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call"]
                       | otherwise = DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call", RunningWaterfall d W.CleanUp]
                   in  
                     do