Apr25 (#274)

* include Pre: HasPass/IsOutstanding
* move away from stack
* Lift pool current balance query
* add eq to result component
* Using DL
* refactor Z-bond due prin
* enable maxSpread
* [root finder] finalise new spread finder
* Expose bal in FixedAsset; Expose extend periods in FixedAsset
* Finalized DDB in Fixed Asset
* Expose default on lease
* fix first loss algo
* LEASE: fix current balance
* fix default on rental algo
* expose rental change vec

Author: yellowbean

.github/workflows/docker-image-dev-by-tag.yml

@@ -53,3 +53,5 @@ jobs:
           tags: ${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:dev, ${{ steps.meta.outputs.tags }}
           cache-from: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache
           cache-to: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache,mode=max  
+
+          

.github/workflows/docker-image-dev.yml

@@ -57,4 +57,5 @@ jobs:
           context: "{{defaultContext}}"
           push: true
           tags: ${{ steps.meta.outputs.tags }}
-          labels: ${{ steps.meta.outputs.labels }}
+          labels: ${{ steps.meta.outputs.labels }}
+

.github/workflows/docker-image.yml

@@ -157,4 +157,4 @@ jobs:
           tags: ${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:latest,  ${{ steps.meta.outputs.tags }}
           cache-from: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache
           cache-to: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache,mode=max       
-          
+          

.github/workflows/haskell.yml

@@ -35,12 +35,13 @@ jobs:
 
     - name: Install dependencies
       run: |
-        stack update
-        stack build   
+        cabal update
     - name: Build
-      run: stack build
+      run: cabal build
     - name: Run tests
-      run: stack test
+      run: cabal test
 
     - name: Badge Action
       uses: emibcn/badge-action@v1.2.4
+
+      

CHANGELOG.md

@@ -2,24 +2,39 @@
 
 <!-- towncrier release notes start -->
 
+## 0.45.7
+### 2025-05-26
+* ENHANCE: add `BaseByVec` for vector-based rental change
+
+
+## 0.45.5
+### 2025-05-20
+* NEW: `MaxSpread` feature for structuring stage: get max possible bond coupon rate !
+* ENHANCE: Transfer from `stack` to `cabal` as build tool
+* ENHANCE: Apply `DList` to trigger log
+* ENHANCE: Enable `Double Decline Balance` in `FixedAsset`
+* REFACTOR: Refactor `Leasing` asset type
+  * Add `Default` assumption
+  * Add `Period-based` rental ,in addition to `Day-based` rental calculation
+
+
+## 0.45.2
+### 2025-04-01
+* ENHANCE: Performance optimization by replace `List` with `DList`.
+* ENHANCE: In `inspection` ,expose `IsOutstanding` `HasPassedMaturity` in `Pre`
+
 ## 0.45.1
 ### 2025-03-25
-* BREAK: 
 * FIX: in `Pricing/IRR`, error when holding position is too small
-* NEW: 
 * ENHANCE: engine will auto patch `interest start date` for bonds if it is not modeled. In `PreClosing` status, engine will use `closing date` as bond interest begin date ; In `Non-PreClosing` status, it defaults to use last waterfall distribution date as bond interest begin date.
 
-
 ## 0.45.0
 ### 2025-03-21
 * BREAK: remove unused `DealDates` : `FixInterval`, `CustomDates` and `PatternInterval`. Since all these can be replace by new `GenericDates` in type `DateDesp`
 * ENHANCE: now bond with `No last interest accure day` will begin accrue interest from `closing date` if the deal is in `PreClosing` mode, while the bond will use `last bond day` otherwise.
 * FIX: `IsPaidOff` now can be queried in inspection formula
 
 
-
-
-
 ## 0.44.0
 ### 2025-03-11
 * BREAK: Add `PAC` `PAC Anchor` to `BondGroup`, now `BondGroup` is `Map String L.Bond (Maybe PrinType)`

Dockerfile

@@ -1,11 +1,10 @@
-FROM fpco/stack-build:lts-22.6 as build
+FROM haskell:9.8.4-slim-bullseye as build
 RUN mkdir /opt/build
 COPY . /opt/build
-RUN cd /opt/build && stack build  --copy-bins  \ 
-    --local-bin-path /opt/build  --resolver lts-22.6 # --system-ghc
+RUN cd /opt/build && cabal update && cabal install
 
 
-FROM --platform=linux/amd64 ubuntu:22.04
+FROM --platform=linux/amd64 ubuntu:25.04
 RUN mkdir -p /opt/myapp
 ARG BINARY_PATH
 WORKDIR /opt/myapp
@@ -15,7 +14,7 @@ RUN apt-get update && apt-get install -y \
 # NOTICE THIS LINE
 
 
-COPY --from=build /opt/build/Hastructure-exe .
+COPY --from=build /root/.local/bin/Hastructure-exe .
 COPY --from=build /opt/build/config.yml .
 COPY --from=build /opt/build/swagger.json .
 #COPY config.yml /opt/myapp

Hastructure.cabal

@@ -1,4 +1,4 @@
-cabal-version: 1.12
+cabal-version: 3.0
 
 -- This file has been generated from package.yaml by hpack version 0.37.0.
 --
@@ -13,7 +13,7 @@ bug-reports:    https://github.com/yellowbean/Hastructure/issues
 author:         Xiaoyu
 maintainer:     always.zhang@gmail.com
 copyright:      2025 Xiaoyu, Zhang
-license:        BSD3
+license:        BSD-3-Clause
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
@@ -24,6 +24,8 @@ source-repository head
   type: git
   location: https://github.com/yellowbean/Hastructure
 
+with-compiler: ghc-9.8.2
+
 library
   exposed-modules:
       Accounts
@@ -67,14 +69,21 @@ library
       Util
       Validation
       Waterfall
-      WebUI
   other-modules:
       Paths_Hastructure
   hs-source-dirs:
       src
   build-depends:
       Decimal
+    , base-compat
+    , attoparsec
+    , string-conversions
+    , warp
+    , wai-cors
+    , http-types
+    , exceptions
     , aeson
+    , attoparsec-aeson
     , aeson-pretty
     , base
     , bytestring
@@ -84,7 +93,6 @@ library
     , hashable
     , ieee754
     , lens
-    , lucid
     , math-functions
     , monad-loops
     , mtl
@@ -104,9 +112,12 @@ library
     , template-haskell
     , text
     , time
-    , vector
     , wai
     , yaml
+    , vector
+    , MissingH
+    , dlist
+--    , proto3-wire
   default-language: Haskell2010
 
 executable Hastructure-exe
@@ -135,7 +146,6 @@ executable Hastructure-exe
     , http-types
     , ieee754
     , lens
-    , lucid
     , math-functions
     , monad-loops
     , mtl
@@ -158,11 +168,12 @@ executable Hastructure-exe
     , text
     , time
     , unordered-containers
-    , vector
     , wai
     , wai-cors
     , warp
     , yaml
+    , dlist
+--    , proto3-suite
   default-language: Haskell2010
 
 test-suite Hastructure-test
@@ -205,7 +216,6 @@ test-suite Hastructure-test
     , hashable
     , ieee754
     , lens
-    , lucid
     , math-functions
     , monad-loops
     , mtl
@@ -229,7 +239,9 @@ test-suite Hastructure-test
     , template-haskell
     , text
     , time
-    , vector
     , wai
     , yaml
+    , vector
+    , MissingH
+    , dlist
   default-language: Haskell2010

LICENSE

@@ -1,4 +1,4 @@
-Copyright Xiaoyu Zhang (always.zhang A_T gmail ) (c) 2022-2024
+Copyright Xiaoyu Zhang (always.zhang A_T gmail ) (c) 2022-2025
 
 All rights reserved.
 

app/Main.hs

@@ -44,7 +44,6 @@ import GHC.Generics
 import GHC.Real
 import qualified Data.ByteString.Lazy.Char8 as BL8
 import qualified Data.ByteString.Char8 as BS
-import Lucid hiding (type_)
 import Network.Wai
 import Network.Wai.Handler.Warp
 import Network.Wai.Middleware.Cors
@@ -101,7 +100,7 @@ debug = flip Debug.Trace.trace
 
 
 version1 :: Version 
-version1 = Version "0.44.2"
+version1 = Version "0.45.7"
 
 
 wrapRun :: DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp
@@ -241,16 +240,6 @@ stressRevovlingPerf r (Just (AP.AvailableAssets rp applyAssumpType))
 stressRevovlingPerf r (Just (AP.AvailableAssetsBy m))
   = Just (AP.AvailableAssetsBy (Map.map (over (_2 . AP.applyAssumptionTypeAssetPerf . _1) (stressAssetPerf r)) m))
 
-dtToBonds :: DealType -> Map.Map BondName L.Bond
-dtToBonds (MDeal d) = DB.bonds d
-dtToBonds (RDeal d) = DB.bonds d
-dtToBonds (IDeal d) = DB.bonds d
-dtToBonds (LDeal d) = DB.bonds d
-dtToBonds (FDeal d) = DB.bonds d
-dtToBonds (UDeal d) = DB.bonds d
-dtToBonds (VDeal d) = DB.bonds d
-dtToBonds (PDeal d) = DB.bonds d
-
 modifyDealType :: DM.ModifyType -> Double -> DealType -> DealType
 modifyDealType dm f (MDeal d) = MDeal $ DM.modDeal dm f d
 modifyDealType dm f (RDeal d) = RDeal $ DM.modDeal dm f d
@@ -281,42 +270,67 @@ queryDealTypeBool (UDeal _d) d s = Q.queryDealBool _d s d
 queryDealTypeBool (VDeal _d) d s = Q.queryDealBool _d s d
 queryDealTypeBool (PDeal _d) d s = Q.queryDealBool _d s d
 
+getDealBondMap :: DealType -> Map.Map BondName L.Bond
+getDealBondMap (MDeal d) = DB.bonds d
+getDealBondMap (RDeal d) = DB.bonds d
+getDealBondMap (IDeal d) = DB.bonds d
+getDealBondMap (LDeal d) = DB.bonds d
+getDealBondMap (FDeal d) = DB.bonds d
+getDealBondMap (UDeal d) = DB.bonds d
+getDealBondMap (VDeal d) = DB.bonds d
+getDealBondMap (PDeal d) = DB.bonds d
+
+getDealFeeMap :: DealType -> Map.Map FeeName F.Fee
+getDealFeeMap (MDeal d) = DB.fees d
+getDealFeeMap (RDeal d) = DB.fees d
+getDealFeeMap (IDeal d) = DB.fees d
+getDealFeeMap (LDeal d) = DB.fees d
+getDealFeeMap (FDeal d) = DB.fees d
+getDealFeeMap (UDeal d) = DB.fees d
+getDealFeeMap (VDeal d) = DB.fees d
+getDealFeeMap (PDeal d) = DB.fees d
 
 -- stress the pool performance, till a bond suffers first loss
 testByDefault :: DealType -> AP.ApplyAssumptionType -> AP.NonPerfAssumption -> BondName -> Double -> Double
 testByDefault dt assumps nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving} bn r 
   = let 
       stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressAssetPerf (toRational r)) assumps
       stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (toRational r) mRevolving }
-      runResult = wrapRun dt (Just stressed) stressedNonPerf
+      runResult = wrapRun dt (Just stressed) stressedNonPerf -- `debug` ("running stress "++ show stressed)
     in
       case runResult of 
         Right (d,mPoolCfMap,mResult,mPricing) -> 
           let 
-            bondBal = L.getOutstandingAmount $ (dtToBonds d) Map.! bn
+            bondBal = L.getOutstandingAmount $ (getDealBondMap d) Map.! bn
           in
-            (fromRational (toRational bondBal) - 0.01)
+            (fromRational (toRational bondBal) - 0.01) -- `debug` (">>> test run result"++ show (fromRational (toRational bondBal) - 0.01))
         Left errorMsg -> error $ "Error in test fun for first loss" ++ show errorMsg
 
 
 -- add spread to bonds till PV of bond (discounted by pricing assumption) equals to face value
 -- with constraint that all liabilities are paid off
-testBySpread :: DealRunInput -> (BondName,[BondName]) -> Double -> Double
-testBySpread (dt,mPAssump,runAssump) (bn,bnds) f 
+testBySpread :: DealRunInput -> (BondName,Bool,Bool) -> Double -> Double
+testBySpread (dt,mPAssump,runAssump) (bn,otherBondFlag,otherFeeFlag) f 
   = let
-      runResult = wrapRun (modifyDealType (DM.AddSpreadToBonds bnds) f dt) mPAssump runAssump
+      runResult = wrapRun (modifyDealType (DM.AddSpreadToBonds bn) f dt) mPAssump runAssump
     in 
       case runResult of 
-        Right (d, mPoolCfMap, mResult, pResult) -> 
+        Right (dt, mPoolCfMap, mResult, pResult) -> 
           let 
+            -- bnds
+            otherBondsName = [] 
+            -- check fees/other bonds
+            otherBondOustanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealBondMap dt)
+            otherBondOustanding False = 0.0
+            feeOutstanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealFeeMap dt)
+            feeOutstanding False = 0.0 
             v = getPriceValue $ pResult Map.! bn
-            bond = dtToBonds d Map.! bn
+            bondBal = L.getOriginBalance $ (getDealBondMap dt) Map.! bn
           in
-            -- if L.getCurBalance bond > 0 then
-            if True then
-              1.0
+            if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0  then 
+              -1
             else
-              (fromRational . toRational) (v - L.getOriginBalance bond)
+              (fromRational . toRational) $ bondBal - v -- `debug` ("rate"++ show f ++ "bondBal:"++ show bondBal++"v:"++ show v)
         Left errorMsg -> error $ "Error in test fun for spread testing" ++ show errorMsg
 
 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp)
@@ -335,17 +349,17 @@ runRootFinderBy (FirstLossReq (dt,Just assumps,nonPerfAssump@AP.NonPerfAssumptio
           NotBracketed -> Left "Not able to bracket the root"
           SearchFailed -> Left "Not able to find the root"
 
-runRootFinderBy (MaxSpreadToFaceReq (dt,pAssump,dAssump) (bn,bnds)) 
+runRootFinderBy (MaxSpreadToFaceReq (dt,pAssump,dAssump) bns chkOtherBnds chkOtherFees) 
   = return $
       let 
         itertimes = 500
         def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.0001}
       in 
-        case ridders def (0.00,200.0) (testBySpread (dt,pAssump,dAssump) (bn,bnds)) of
+        case ridders def (0.00,200.0) (testBySpread (dt,pAssump,dAssump) (bns,chkOtherBnds,chkOtherFees)) of
           Root r -> let 
-                      dt' = modifyDealType (DM.AddSpreadToBonds bnds) r dt  
+                      dt' = modifyDealType (DM.AddSpreadToBonds bns) r dt
                     in 
-                      Right $ BestSpreadResult r (dtToBonds dt') dt' 
+                      Right $ BestSpreadResult r (getDealBondMap dt') dt' 
           NotBracketed -> Left "Not able to bracket the root"
           SearchFailed -> Left "Not able to find the root"