0.28.3

ChangeLog.md

@@ -1,5 +1,10 @@
 # Changelog for Hastructure
 
+## 0.28.3
+### TODO
+* FIX: `limit` on `payFee` was not working with `duePct`
+
+
 ## 0.28.2
 ### 2024-05-27
 * NEW: enable `trigger` to run waterfall `actions`

app/Main.hs

@@ -102,7 +102,7 @@ $(deriveJSON defaultOptions ''Version)
 instance ToSchema Version
 
 version1 :: Version 
-version1 = Version "0.28.2"
+version1 = Version "0.28.5"
 
 
 data DealType = MDeal (DB.TestDeal AB.Mortgage)
@@ -337,7 +337,7 @@ data RunPoolReq = SingleRunPoolReq PoolTypeWrap (Maybe AP.ApplyAssumptionType) (
 
 instance ToSchema RunPoolReq
 
-data RunDateReq = RunDateReq Date DatePattern
+data RunDateReq = RunDateReq Date DatePattern (Maybe Date)
                 deriving(Show, Generic)
 instance ToSchema RunDateReq
 
@@ -402,7 +402,10 @@ runMultiDeals :: RunDealReq -> Handler (Map.Map ScenarioName RunResp)
 runMultiDeals (MultiDealRunReq mDts assump nonPerfAssump) = return $ Map.map (\singleDealType -> wrapRun singleDealType assump nonPerfAssump) mDts
 
 runDate :: RunDateReq -> Handler [Date]
-runDate (RunDateReq sd dp) = return $ DU.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101")
+runDate (RunDateReq sd dp md) = return $ 
+                                    case md of
+                                      Nothing -> DU.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101")
+                                      Just d -> DU.genSerialDatesTill2 IE sd dp d
 
 myServer :: ServerT API Handler
 myServer =  return engineSwagger

src/Deal.hs

@@ -249,9 +249,9 @@ queryTrigger t@TestDeal{ triggers = trgs } wt
       Just _trgs -> maybe [] Map.elems $ Map.lookup wt _trgs
 
 -- ^ run trigger sequentially
-testTriggers :: Ast.Asset a => TestDeal a -> Date -> [Trigger] -> Bool
-testTriggers t d [] = False
-testTriggers t d triggers = any (testTrigger t d) triggers 
+-- testTriggers :: Ast.Asset a => TestDeal a -> Date -> [Trigger] -> Bool
+-- testTriggers t d [] = False
+-- testTriggers t d triggers = any (testTrigger t d) triggers 
 
 -- ^ execute effects of trigger: making changes to deal
 runEffects :: Ast.Asset a => (TestDeal a, RunContext a) -> Date -> TriggerEffect -> (TestDeal a, RunContext a)
@@ -271,7 +271,7 @@ runEffects (t@TestDeal{accounts = accMap, fees = feeMap },rc) d te
       DoNothing -> (t, rc)
       _ -> error $ "Failed to match trigger effects: "++show te
 
--- ^ test trigger and add a log if deal status changed
+-- ^ test triggers in the deal and add a log if deal status changed
 runTriggers :: Ast.Asset a => (TestDeal a, RunContext a) -> Date -> DealCycle -> (TestDeal a, RunContext a,[ResultComponent])
 runTriggers (t@TestDeal{status=oldStatus, triggers = Nothing},rc) d dcycle = (t, rc, [])
 runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc) d dcycle = 
@@ -281,14 +281,18 @@ runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc) d dcycle =
 
     -- get triggeres to run at `dealCycle`
     trgsMap = Map.findWithDefault Map.empty dcycle trgM
-    -- triggered trigger
-    triggeredTrgs = Map.filter   
-                          (\trg -> 
-                            (not (trgStatus trg) || trgStatus trg && trgCurable trg) && testTrigger t d trg)
+
+    -- get a map of triggers to test
+    trgsToTest = Map.filter   
+                          (\trg -> (not (trgStatus trg) || trgStatus trg && trgCurable trg))
                           trgsMap
+    -- test triggers 
+    triggeredTrgs = Map.map
+                          (\trg -> testTrigger t d trg)
+                          trgsToTest
 
-    -- extract trigger effects to run                   
-    triggeredEffects = [ trgEffects _trg | _trg <- Map.elems triggeredTrgs ] 
+    -- extract trigger effects to run, if the trigger is true                   
+    triggeredEffects = [ trgEffects _trg | _trg <- Map.elems triggeredTrgs, (trgStatus _trg) ] 
 
     -- run effects on deals
     -- aka (\_t _te -> runEffects _t d _te)
@@ -301,7 +305,7 @@ runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc) d dcycle =
     -- new status of trigger, update status of trigger to True
     triggeredNames = Map.keys triggeredTrgs
 
-    newTriggers = Map.union (Map.map (set trgStatusLens True) triggeredTrgs) trgsMap
+    newTriggers = Map.union triggeredTrgs trgsMap
 
 
 run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.CashFlowFrame -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe [C.CallOption] 
@@ -999,4 +1003,4 @@ depositPoolFlow rules d pFlowMap amap
   -- = foldr (\pflowM acc -> depositPoolInflow rules d pflowM acc) amap $ pFlowMap `debug` ("Deposit p fd"++ show (Map.elems pFlowMap))
   = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules
 
-$(deriveJSON defaultOptions ''ExpectReturn)
+$(deriveJSON defaultOptions ''ExpectReturn)

src/Deal/DealAction.hs

@@ -77,15 +77,22 @@ getPoolFlows t@TestDeal{ pool = _pool } sd ed rt =
   where
     trs = getAllCollectedTxnsList t Nothing
 
-testTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Bool 
-testTrigger t d trigger@Trigger{ trgStatus=st,trgCurable=cure,trgCondition=cond } 
-  | not cure && st = True 
-  | otherwise = testPre d t cond 
 
-updateTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Trigger
-updateTrigger t d trigger@Trigger{ trgStatus=st,trgCurable=cure,trgCondition=cond}
-  | testTrigger t d trigger = trigger {trgStatus = True}  
-  | otherwise = trigger
+-- ^ 
+testTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Trigger
+testTrigger t d trigger@Trigger{trgStatus=st,trgCurable=curable,trgCondition=cond,trgStmt = tStmt} 
+  | not curable && st = trigger
+  | otherwise = let 
+                  newSt = testPre d t cond
+                  newTxn = TrgTxn d newSt Stmt.Empty
+                in 
+                  trigger { trgStatus = newSt
+                           , trgStmt = Stmt.appendStmt tStmt newTxn}
+
+-- updateTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Trigger
+-- updateTrigger t d trigger@Trigger{ trgStatus=st,trgCurable=cure,trgCondition=cond}
+--   | testTrigger t d trigger = trigger {trgStatus = True}  
+--   | otherwise = trigger
 
 pricingAssets :: PricingMethod -> [ACM.AssetUnion] -> Date -> Amount 
 pricingAssets (BalanceFactor currentfactor defaultfactor) assets d = 0 
@@ -733,17 +740,21 @@ performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFee mLimit an fns
     supportAvail = case mSupport of 
                      Just support -> sum ( evalExtraSupportBalance d t support)
                      Nothing -> 0
-    amtAvailable = case mLimit of
-                     Nothing -> availAccBal + supportAvail
-                     Just (DS ds) -> min (availAccBal + supportAvail) $ queryDeal t (patchDateToStats d ds)
-                     Just (DueCapAmt amt) -> min amt $ availAccBal + supportAvail
-
+
     feesToPay = map (feeMap Map.!) fns
     feeDueAmts = map F.feeDue feesToPay
+    feeTotalDueAmt = sum feeDueAmts
+
+    amtAvailable = availAccBal + supportAvail
                    -- Just (DuePct pct) -> map (\x -> mulBR (F.feeDue x) pct ) feesToPay
                    -- Just (DueCapAmt amt) -> prorataFactors (F.feeDue <$> feesToPay) amt
+    dueAmtAfterCap = case mLimit of 
+                      Nothing -> feeTotalDueAmt
+                      Just (DS ds) -> min (queryDeal t (patchDateToStats d ds)) feeTotalDueAmt
+                      Just (DueCapAmt amt) -> min amt feeTotalDueAmt
+                      Just (DuePct pct) -> mulBR feeTotalDueAmt pct
     -- total actual pay out
-    actualPaidOut = min amtAvailable $ sum feeDueAmts -- `debug` ("Fee Due Amounts"++show(feeDueAmts))
+    actualPaidOut = min amtAvailable dueAmtAfterCap
 
     feesAmountToBePaid = zip feesToPay $ prorataFactors feeDueAmts actualPaidOut
     feesPaid = map (\(f,amt) -> F.payFee d amt f) feesAmountToBePaid
@@ -752,7 +763,7 @@ performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFee mLimit an fns
     dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap
                      ,fees = Map.fromList (zip fns feesPaid) <> feeMap}
 
-    supportPaidOut = sum feeDueAmts - accPaidOut
+    supportPaidOut = dueAmtAfterCap - accPaidOut
 
 performAction d t (W.AccrueAndPayIntBySeq mLimit an bnds mSupport)
   = let 
@@ -1341,6 +1352,7 @@ performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapS
 performAction d t@TestDeal{ triggers = Just trgM } (W.RunTrigger loc tName)
   = t { triggers = Just (Map.insert loc newMap trgM) }
     where 
-      newMap = Map.adjust (updateTrigger t d) tName (trgM Map.! loc)
+      -- newMap = Map.adjust (updateTrigger t d) tName (trgM Map.! loc)
+      newMap = Map.adjust (testTrigger t d) tName (trgM Map.! loc)
 
 performAction d t action =  error $ "failed to match action>>"++show action++">>Deal"++show (name t)

src/Stmt.hs

@@ -72,6 +72,7 @@ getTxnComment (ExpTxn _ _ _ _ t ) = t
 getTxnComment (SupportTxn _ _ _ _ _ _ t ) = t
 getTxnComment (IrsTxn _ _ _ _ _ _ t ) = t
 getTxnComment (EntryTxn _ _ _ t ) = t
+getTxnComment (TrgTxn _ _ t) = t
 
 getTxnBalance :: Txn -> Balance
 getTxnBalance (BondTxn _ t _ _ _ _ _ _ _ _) = t
@@ -96,6 +97,7 @@ getTxnAmt (ExpTxn _ _ t _ _ ) = t
 getTxnAmt (SupportTxn _ _ t _ _ _ _) = t
 getTxnAmt (IrsTxn _ _ t _ _ _ _ ) = t
 getTxnAmt (EntryTxn _ _ t _) = t
+getTxnAmt (TrgTxn {} ) = 0.0
 
 getTxnAsOf :: [Txn] -> Date -> Maybe Txn
 getTxnAsOf txns d = find (\x -> getDate x <= d) $ reverse txns
@@ -107,6 +109,7 @@ emptyTxn ExpTxn {} d = ExpTxn d 0 0 0 Empty
 emptyTxn SupportTxn {} d = SupportTxn d Nothing 0 0 0 0 Empty
 emptyTxn IrsTxn {} d = IrsTxn d 0 0 0 0 0 Empty
 emptyTxn EntryTxn {} d = EntryTxn d 0 0 Empty
+emptyTxn TrgTxn {} d = TrgTxn d False Empty
 
 isEmptyTxn :: Txn -> Bool
 isEmptyTxn (BondTxn _ 0 0 0 _ 0 0 0 _ _) = True

src/Triggers.hs

@@ -8,6 +8,7 @@ module Triggers(
  where
 
 import qualified Data.Text as T
+import qualified Stmt as S
 import Text.Read (readMaybe)
 import Lib ( Pre, DealStatus )
 import Types
@@ -43,11 +44,12 @@ data Trigger = Trigger {
             ,trgEffects :: TriggerEffect              -- ^ what happen if it was triggered
             ,trgStatus :: Bool                        -- ^ if it is triggered or not 
             ,trgCurable :: Bool                       -- ^ if it is curable trigger
+            ,trgStmt :: Maybe S.Statement             -- ^ Transaction stmt
             } deriving (Show, Eq, Generic,Ord)
 
 makeLensesFor [("trgStatus","trgStatusLens") 
                 ,("trgEffects","trgEffectsLens") 
                 ,("trgCondition","trgConditionLens") 
                 ,("trgCurable","trgCurableLens")] ''Trigger
 
-$(concat <$> traverse (deriveJSON defaultOptions) [''TriggerEffect, ''Trigger])
+$(concat <$> traverse (deriveJSON defaultOptions) [''TriggerEffect, ''Trigger])

src/Types.hs

@@ -24,7 +24,7 @@ module Types
   ,RoundingBy(..),DateDirection(..)
   ,TxnComment(..),BookDirection(..),DealStatType(..),getDealStatType
   ,Liable(..),CumPrepay,CumDefault,CumDelinq,CumPrincipal,CumLoss,CumRecovery,PoolId(..)
-  ,DealName,lookupIntervalTable,getPriceValue,Txn(..)
+  ,DealName,lookupIntervalTable,getPriceValue,Txn(..),preToStr
   )
 
   where
@@ -352,12 +352,15 @@ type DueInt = Balance
 type DuePremium = Balance
 type DueIoI = Balance
 
+
+
 data Txn = BondTxn Date Balance Interest Principal IRate Cash DueInt DueIoI (Maybe Float) TxnComment     -- ^ bond transaction record for interest and principal 
          | AccTxn Date Balance Amount TxnComment                                                         -- ^ account transaction record 
          | ExpTxn Date Balance Amount Balance TxnComment                                                 -- ^ expense transaction record
          | SupportTxn Date (Maybe Balance) Amount Balance DueInt DuePremium TxnComment                   -- ^ liquidity provider transaction record
          | IrsTxn Date Balance Amount IRate IRate Balance TxnComment                                     -- ^ interest swap transaction record
          | EntryTxn Date Balance Amount TxnComment                                                       -- ^ ledger book entry
+         | TrgTxn Date Bool TxnComment
          deriving (Show, Generic, Eq)
 
 
@@ -675,6 +678,8 @@ data Pre = IfZero DealStats
          | All [Pre]                            -- ^ 
          deriving (Show,Generic,Eq,Ord)
 
+preToStr :: Pre -> String
+preToStr p = show p
 
 
 type BookItems = [BookItem]

swagger.json

@@ -6407,35 +6407,6 @@
                         "title": "BondDuePrin",
                         "type": "object"
                     },
-                    {
-                        "properties": {
-                            "contents": {
-                                "items": [
-                                    {
-                                        "type": "string"
-                                    },
-                                    {
-                                        "$ref": "#/components/schemas/DealStats"
-                                    }
-                                ],
-                                "maxItems": 2,
-                                "minItems": 2,
-                                "type": "array"
-                            },
-                            "tag": {
-                                "enum": [
-                                    "BondGroup"
-                                ],
-                                "type": "string"
-                            }
-                        },
-                        "required": [
-                            "tag",
-                            "contents"
-                        ],
-                        "title": "BondGroup",
-                        "type": "object"
-                    },
                     {
                         "properties": {
                             "contents": {
@@ -16352,7 +16323,7 @@
             "name": "BSD 3"
         },
         "title": "Hastructure API",
-        "version": "0.28.1"
+        "version": "0.28.2"
     },
     "openapi": "3.0.0",
     "paths": {