From ff59b6f61659943ee427700345ba62633330d8ae Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sun, 30 Jun 2024 16:24:22 +0800 Subject: [PATCH] implement new bond selector to support bond groups --- ChangeLog.md | 11 +++++++---- src/Deal/DealBase.hs | 20 ++++++++++++++++++++ src/Deal/DealQuery.hs | 26 ++++++++++---------------- swagger.json | 2 +- 4 files changed, 38 insertions(+), 21 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index cde7d75a..ed4cd3d0 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,11 +1,14 @@ # Changelog for Hastructure -## 0.28.8 -### TODO -* NEW: new assumption `issue bond` which allow funding by issue new bonds during cashflow projection. +## 0.28.11 +### 2024-06-30 +* NEW: new assumption `issue bond` which allow funding by issuing new bonds during cashflow projection. * FIX: `formula` will return `inf` if a `divide` with zero instead of just throw exception +* NEW: new asset class `projectScheduleFlow` which can be divided projected cashflow with fix portion and float portions. The interest from the float portion will be affected by interest rate assumption. +* FIX: `financial reports` was failing because it can't access to `interest due` on bond group. +* FIX: enable formula query on `bond groups` -## 0.28.3 +## 0.28.8 ### 2024-06 * FIX: `limit` on `payFee` was not working with `duePct` * ENHANCE: expose `transaction statement` for `triggers` diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index 3e5cd918..52b835fc 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -11,6 +11,7 @@ module Deal.DealBase (TestDeal(..),SPV(..),dealBonds,dealFees,dealAccounts,dealP ,getIssuanceStatsConsol,getAllCollectedTxnsList,dealScheduledCashflow ,getPoolIds,getBondByName, UnderlyingDeal(..),dealCashflow, uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..),OverrideType(..) ,sortActionOnDate,viewDealAllBonds,dealBondGroups + ,viewDealBondsByNames ) where import qualified Accounts as A @@ -328,6 +329,25 @@ viewDealAllBonds d = in concat $ view <$> bs +viewDealBondsByNames :: Ast.Asset a => TestDeal a -> [BondName] -> [L.Bond] +viewDealBondsByNames _ [] = [] +viewDealBondsByNames t@TestDeal{bonds= bndMap } bndNames + = let + -- bonds and bond groups + bnds = filter (\b -> L.bndName b `elem` bndNames) $ viewDealAllBonds t + -- bndsFromGrp = $ Map.filter (\L.BondGroup {} -> True) bndMap + bndsFromGrp = Map.foldrWithKey + (\k (L.BondGroup bMap) acc -> + if k `elem` bndNames + then + acc ++ Map.elems bMap + else + acc) + [] + (view dealBondGroups t ) + in + bnds ++ bndsFromGrp + dealBonds :: Ast.Asset a => Lens' (TestDeal a) (Map.Map BondName L.Bond) dealBonds = lens getter setter where diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index 90a3f2a3..1e77284c 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -214,11 +214,11 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM OriginalBondBalance -> Map.foldr (\x acc -> getOriginBalance x + acc) 0.0 bndMap - BondDuePrin bnds -> sum $ L.bndDuePrin <$> ((bndMap Map.!) <$> bnds) --TODO Failed if bond group + BondDuePrin bnds -> sum $ L.bndDuePrin <$> viewDealBondsByNames t bnds - OriginalBondBalanceOf bnds -> sum $ getOriginBalance . (bndMap Map.!) <$> bnds + OriginalBondBalanceOf bnds -> sum $ getOriginBalance <$> viewDealBondsByNames t bnds - CurrentBondBalanceOf bns -> sum $ getCurBalance . (bndMap Map.!) <$> bns -- `debug` ("Current bond balance of"++show (sum $ L.bndBalance . (bndMap Map.!) <$> bns)) + CurrentBondBalanceOf bns -> sum $ getCurBalance <$> viewDealBondsByNames t bns CurrentPoolBalance mPns -> foldl (\acc x -> acc + P.getCurrentBal x) 0.0 (getAllAssetList t) --TODO TOBE FIX: mPns is not used @@ -378,15 +378,9 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM in sum pvs -- `debug` ("pvs"++ show pvs) - -- OriginalBondBalanceOf bns -> sum $ L.originBalance . L.bndOriginInfo <$> (bndMap Map.!) <$> bns - -- IsPaidOff bns -> all isPaidOff <$> (theBondGrp Map.!) <$> bns - - - BondsIntPaidAt d bns -> let - bSubMap = getBondsByName t (Just bns) -- Map.filterWithKey (\bn b -> S.member bn bnSet) (bonds t) - stmts = map L.bndStmt $ Map.elems bSubMap + stmts = map L.bndStmt $ viewDealBondsByNames t bns ex s = case s of Nothing -> 0 Just (Statement txns) @@ -400,8 +394,7 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM BondsPrinPaidAt d bns -> let - bSubMap = getBondsByName t (Just bns) -- Map.filterWithKey (\bn b -> S.member bn bnSet) (bonds t) - stmts = map L.bndStmt $ Map.elems bSubMap + stmts = map L.bndStmt $ viewDealBondsByNames t bns ex s = case s of Nothing -> 0 Just (Statement txns) @@ -427,7 +420,8 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM BondTxnAmtBy d bns mCmt -> let - bnds = (bndMap Map.!) <$> bns -- Map.elems $ getBondByName t (Just bns) + -- bnds = (bndMap Map.!) <$> bns -- Map.elems $ getBondByName t (Just bns) + bnds = viewDealBondsByNames t bns in case mCmt of Just cmt -> sum [ queryTxnAmtAsOf bnd d cmt | bnd <- bnds ] @@ -479,11 +473,11 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM sum $ map ex stmts CurrentDueBondInt bns -> - sum $ L.bndDueInt <$> (bndMap Map.!) <$> bns -- `debug` ("bond due int" ++ show ((bndMap Map.!) <$> bns )) + sum $ L.bndDueInt <$> viewDealBondsByNames t bns CurrentDueBondIntOverInt bns -> - sum $ L.bndDueIntOverInt <$> (bndMap Map.!) <$> bns -- `debug` ("bond due int" ++ show ((bndMap Map.!) <$> bns )) - + sum $ L.bndDueIntOverInt <$> viewDealBondsByNames t bns + CurrentDueBondIntTotal bns -> sum (queryDeal t <$> [CurrentDueBondInt bns,CurrentDueBondIntOverInt bns]) CurrentDueFee fns -> sum $ F.feeDue <$> (feeMap Map.!) <$> fns diff --git a/swagger.json b/swagger.json index 4b01f736..57d4e0c7 100644 --- a/swagger.json +++ b/swagger.json @@ -17098,7 +17098,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.28.10" + "version": "0.28.11" }, "openapi": "3.0.0", "paths": {