Dec 25 : Release

Hastructure.cabal

@@ -5,15 +5,15 @@ cabal-version: 3.0
 -- see: https://github.com/sol/hpack
 
 name:           Hastructure
-version: 0.52.0
+version: 0.52.3
 synopsis:       Cashflow modeling library for structured finance
 description:    Please see the README on GitHub at <https://github.com/absbox/Hastructure#readme>
 category:       StructuredFinance,Securitisation,Cashflow
 homepage:       https://github.com/absbox/Hastructure#readme
 bug-reports:    https://github.com/absbox/Hastructure/issues
 author:         Xiaoyu
 maintainer:     always.zhang@gmail.com
-copyright:      2025 Xiaoyu, Zhang
+copyright:      2026 Xiaoyu, Zhang
 license:        BSD-3-Clause
 license-file:   LICENSE
 build-type:     Simple
@@ -90,13 +90,13 @@ library
     regex-base >= 0.94.0 && < 0.95,
     aeson >= 2.2.3 && < 2.3,
     aeson-gadt-th >= 0.2.5.4 && < 0.3,
-    hashable >= 1.4.7 && < 1.5.1,
+    hashable >= 1.4 && <= 1.5.1.0,
     dlist >= 1.0 && < 1.1,
     scientific >= 0.3.8 && < 0.4,
     vector >= 0.13.2 && < 0.14,
     aeson-pretty >= 0.8.10 && < 0.9,
     base-compat >= 0.13.0 && < 0.15,
-    lens >= 5.2.3 && < 5.3.6,
+    lens >= 5.2.3 && < 5.4,
     parallel >= 3.2.2 && < 3.3,
     math-functions >= 0.3.4 && < 0.4,
     monad-loops >= 0.4.3 && < 0.5,

app/Main.hs

@@ -100,7 +100,7 @@ debug = flip Debug.Trace.trace
 
 
 version1 :: Version 
-version1 = Version "0.52.0"
+version1 = Version "0.52.3"
 
 
 wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp

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/Analytics.hs

@@ -255,9 +255,9 @@ calcRequiredAmtForIrrAtDate irr ds vs d =
     itertimes = 500
     def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.00000001}
   in 
-    case ridders def (0.0001,100000000000000) (calcPvFromIRR irr ds vs d) of
+    case ridders def (-100000000000.0,100000000000000) (calcPvFromIRR irr ds vs d) of
       Root finalAmt -> Just (fromRational (toRational finalAmt))
-      _ -> Nothing
+      error -> Nothing -- `debug` ("calcRequiredAmtForIrrAtDate: error"++ show error)
 
 -- ^ calc IRR from a cashflow 
 calcIRR :: [Date] -> [Amount] -> Either String Rate
@@ -276,6 +276,6 @@ calcIRR ds vs
       sumOfPv irr = pv22 irr beginDate ds vs'
     in 
       case ridders def (-1,1000) sumOfPv of
-        Root irrRate -> Right $ toRational irrRate
+        Root irrRate -> return $ toRational irrRate
         NotBracketed -> Left $ "IRR: not bracketed" ++ show vs' ++ " and dates"++ show ds
         SearchFailed -> Left $ "IRR: search failed:  can't be calculated with input "++ show vs++" and dates"++ show ds

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

@@ -460,15 +460,17 @@ evalExtraSupportBalance d t (W.MultiSupport supports)
 
 
 -- ^ draw support from a deal , return updated deal,and remaining oustanding amount
-drawExtraSupport :: Date -> Amount -> W.ExtraSupport -> TestDeal a -> Either ErrorRep (TestDeal a, Amount)
+drawExtraSupport :: Ast.Asset a => Date -> Amount -> W.ExtraSupport -> TestDeal a -> Either ErrorRep (TestDeal a, Amount)
 -- ^ draw account support and book ledger
 drawExtraSupport d amt (W.SupportAccount an (Just (dr, ln))) t@TestDeal{accounts=accMap, ledgers= Just ledgerMap}
   = do 
       acc <- lookupM an accMap
       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} 
@@ -497,6 +499,15 @@ drawExtraSupport d amt (W.MultiSupport supports) t
       (t, amt) 
       supports
 
+drawExtraSupport d amt (W.WithCondition pre s) t
+  = do
+      flag <- testPre d t pre
+      if flag then 
+        drawExtraSupport d amt s t
+      else
+        return (t, amt)
+
+
 inspectListVars :: Ast.Asset a => TestDeal a -> Date -> [DealStats] -> Either ErrorRep [ResultComponent]
 inspectListVars t d dss = sequenceA [ inspectVars t d ds | ds <- dss]                     
 
@@ -790,7 +801,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 +826,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 +847,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 +976,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 +1205,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 +1231,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