implement new bond selector to support bond groups

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`

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 

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

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": {