diff --git a/.github/workflows/docker-image.yml b/.github/workflows/docker-image.yml index e6080c82..cee10199 100644 --- a/.github/workflows/docker-image.yml +++ b/.github/workflows/docker-image.yml @@ -157,4 +157,12 @@ 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 - \ No newline at end of file + + publish: + + - uses: haskell-actions/hackage-publish@v1 + with: + hackageToken: ${{ secrets.HACKAGE_KEY }} + packagesPath: ${{ runner.temp }}/packages + docsPath: ${{ runner.temp }}/docs + publish: false diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index d67e65da..9266ea20 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -16,9 +16,9 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2.8.0 with: - ghc-version: 'latest' + ghc-version: '9.8.4' cabal-version: 'latest' - name: Cache @@ -33,7 +33,7 @@ jobs: ${{ runner.os }}-build- ${{ runner.os }}- - - name: Install dependencies + - name: Install depndencies run: | cabal update - name: Build @@ -44,4 +44,4 @@ jobs: - name: Badge Action uses: emibcn/badge-action@v1.2.4 - \ No newline at end of file + diff --git a/CHANGELOG.md b/CHANGELOG.md index 0569783d..7d9787bb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,33 @@ +## 0.50.0 +### 2025-07-14 +* NEW: add `stopBy` in run assumption ,which stop deal run by a list of `Condition` +* NEW: expose `asset level` cashflow ,with a toggle +* NEW: expose `Un-Used Pool cashflow` +* ENHANCE: parameterized the `tweaks` +* ENHANCE: update dependency to accomodate publishment to `Hackage` +* FIX: enable `Lease` deal for `Financial reports` + + +## 0.46.4 +### 2025-06-10 +* ENHANCE: add error message when calculation IRR for bond with non cashflow +* ENHANCE: add `tweak`: `Stress Prepayment` +* ENHANCE: add `stop`: `Bond Principal Loss` `Bond Interest Loss` + + +## 0.46.2 +### 2025-06-08 +* ENHANCE: add `tweak`: `Balance Split` and `stop`: `Bond Met Target IRR` + +## 0.46.1 +### 2025-06-07 +* ENHANCE: add 2 more `leaseEndType` assumptions: `Earlier` `Later` which will end the lease projection base on two input `End date` and `extention times`. +* ENHANCE: expose `new bond rate type` in `trigger effects`. Now bond rate type can be changed during the projection. +* REFACTOR: with new refactor `root finder` endpoint and signature. In the long term, the refactor of signature lays down fundation for `deal structuring` domain, now it would be easy to implement all kinds of structuring features. + ## 0.45.7 ### 2025-05-26 * ENHANCE: add `BaseByVec` for vector-based rental change diff --git a/Hastructure.cabal b/Hastructure.cabal index 9937f210..e01c18b3 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -5,9 +5,10 @@ cabal-version: 3.0 -- see: https://github.com/sol/hpack name: Hastructure -version: 0.45.0 +version: 0.50.1 +synopsis: Cashflow modeling library for structured finance description: Please see the README on GitHub at -category: StructuredFinance;Securitisation;Cashflow +category: StructuredFinance,Securitisation,Cashflow homepage: https://github.com/yellowbean/Hastructure#readme bug-reports: https://github.com/yellowbean/Hastructure/issues author: Xiaoyu @@ -18,14 +19,12 @@ license-file: LICENSE build-type: Simple extra-source-files: README.md +extra-doc-files: CHANGELOG.md - source-repository head type: git location: https://github.com/yellowbean/Hastructure -with-compiler: ghc-9.8.2 - library exposed-modules: Accounts @@ -71,53 +70,56 @@ library Waterfall other-modules: Paths_Hastructure + autogen-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 - , containers - , deepseq - , generic-lens - , hashable - , ieee754 - , lens - , math-functions - , monad-loops - , mtl - , numeric-limits - , openapi3 - , parallel - , regex-base - , regex-pcre-builtin - , regex-tdfa - , scientific - , servant - , servant-openapi3 - , servant-server - , split - , swagger2 - , tabular - , template-haskell - , text - , time - , wai - , yaml - , vector - , MissingH - , dlist --- , proto3-wire + Decimal >= 0.5.2 && < 0.6, + base >= 4.18.0 && < 4.21, + deepseq >= 1.5.1 && < 1.6, + MissingH >= 1.6.0 && < 1.7, + containers >= 0.6.8 && < 0.7, + template-haskell >= 2.20.0 && < 2.21.1.0, + bytestring >= 0.12.1 && < 0.13, + -- exceptions >= 0.10.7 && < 0.11, + mtl >= 2.3.1 && < 2.4, + time >= 1.12.2 && < 1.13, + text >= 2.1.1 && < 2.2, + regex-base >= 0.94.0 && < 0.95, + aeson >= 2.2.3 && < 2.3, + hashable >= 1.4.7 && < 1.5, + 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, + attoparsec >= 0.14.4 && < 0.15, + attoparsec-aeson >= 2.2.2 && < 2.3, + generic-lens >= 2.2.2 && < 2.3, + http-types >= 0.12.4 && < 0.13, + -- ieee754 >= 0.8.0 && < 0.9, + lens >= 5.2.3 && < 5.3.6, + parallel >= 3.2.2 && < 3.3, + math-functions >= 0.3.4 && < 0.4, + monad-loops >= 0.4.3 && < 0.5, + numeric-limits >= 0.1.0 && < 0.2, + openapi3 >= 3.2.4 && < 3.3, + regex-pcre-builtin >= 0.95.2 && < 0.96, + -- regex-tdfa >= 1.3.2 && < 1.4, + servant >= 0.20.2 && < 0.21, + servant-openapi3 >= 2.0.1 && < 2.1, + servant-server >= 0.20.2 && < 0.21, + wai >= 3.2.4 && < 3.3, + warp >= 3.4.7 && < 3.5, + split >= 0.2.5 && < 0.3, + string-conversions >= 0.4.0 && < 0.5, + swagger2 >= 2.8.9 && < 2.9, + tabular >= 0.2.2 && < 0.3, + wai-cors >= 0.2.7 && < 0.3, + yaml >= 0.11.11 && < 0.12, + + default-language: Haskell2010 executable Hastructure-exe @@ -125,60 +127,66 @@ executable Hastructure-exe other-modules: MainBase Paths_Hastructure + autogen-modules: + Paths_Hastructure hs-source-dirs: app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - Decimal - , Hastructure - , aeson - , aeson-pretty - , attoparsec - , attoparsec-aeson - , base - , base-compat - , bytestring - , containers - , deepseq - , exceptions - , generic-lens - , hashable - , http-types - , ieee754 - , lens - , math-functions - , monad-loops - , mtl - , numeric-limits - , openapi3 - , parallel - , regex-base - , regex-pcre-builtin - , regex-tdfa - , scientific - , servant - , servant-checked-exceptions - , servant-openapi3 - , servant-server - , split - , string-conversions - , swagger2 - , tabular - , template-haskell - , text - , time - , unordered-containers - , wai - , wai-cors - , warp - , yaml - , dlist --- , proto3-suite + Hastructure, + Decimal, + base >= 4.18.0 && < 4.20, + deepseq, + MissingH, + containers, + template-haskell, + bytestring, + exceptions, + mtl, + time, + text, + regex-base, + aeson, + hashable, + dlist, + scientific, + vector, + aeson-pretty, + base-compat, + attoparsec, + attoparsec-aeson, + generic-lens, + http-types, + lens, + parallel, + math-functions, + monad-loops, + numeric-limits, + openapi3, + regex-pcre-builtin, + servant, + servant-openapi3, + servant-server, + wai, + warp, + split, + string-conversions, + swagger2, + tabular, + wai-cors, + yaml, + tasty >= 1.5.3 && < 1.6, + tasty-golden >= 2.3.5 && < 2.4, + tasty-hspec >= 1.2.0 && < 1.3, + tasty-hunit >= 0.10.2 && < 0.11, + default-language: Haskell2010 test-suite Hastructure-test type: exitcode-stdio-1.0 main-is: MainTest.hs + autogen-modules: + Paths_Hastructure other-modules: DealTest.DealTest DealTest.MultiPoolDealTest @@ -204,44 +212,50 @@ test-suite Hastructure-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - Decimal - , Hastructure - , aeson - , aeson-pretty - , base - , bytestring - , containers - , deepseq - , generic-lens - , hashable - , ieee754 - , lens - , math-functions - , monad-loops - , mtl - , numeric-limits - , openapi3 - , parallel - , regex-base - , regex-pcre-builtin - , regex-tdfa - , scientific - , servant - , servant-openapi3 - , servant-server - , split - , swagger2 - , tabular - , tasty - , tasty-golden - , tasty-hspec - , tasty-hunit - , template-haskell - , text - , time - , wai - , yaml - , vector - , MissingH - , dlist + Hastructure, + Decimal, + base >= 4.18.0 && < 4.21, + deepseq, + MissingH, + containers, + template-haskell, + bytestring, + exceptions, + mtl, + time, + text, + regex-base, + aeson, + hashable, + dlist, + scientific, + vector, + aeson-pretty, + base-compat, + attoparsec, + attoparsec-aeson, + generic-lens, + http-types, + lens, + parallel, + math-functions, + monad-loops, + numeric-limits, + openapi3, + regex-pcre-builtin, + servant, + servant-openapi3, + servant-server, + wai, + warp, + split, + string-conversions, + swagger2, + tabular, + wai-cors, + yaml, + tasty, + tasty-golden, + tasty-hspec, + tasty-hunit default-language: Haskell2010 diff --git a/Hastructure.nix b/Hastructure.nix new file mode 100644 index 00000000..dbaeebd6 --- /dev/null +++ b/Hastructure.nix @@ -0,0 +1,50 @@ +{ mkDerivation, aeson, aeson-pretty, attoparsec, attoparsec-aeson +, base, base-compat, bytestring, containers, Decimal, deepseq +, dlist, exceptions, generic-lens, hashable, http-types, ieee754 +, lens, lib, math-functions, MissingH, monad-loops, mtl +, numeric-limits, openapi3, parallel, regex-base +, regex-pcre-builtin, regex-tdfa, scientific, servant +, servant-openapi3, servant-server, split, string-conversions +, swagger2, tabular, tasty, tasty-golden, tasty-hspec, tasty-hunit +, template-haskell, text, time, vector, wai, wai-cors, warp, yaml +}: +mkDerivation { + pname = "Hastructure"; + version = "0.45.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + aeson aeson-pretty attoparsec attoparsec-aeson base base-compat + bytestring containers Decimal deepseq dlist exceptions generic-lens + hashable http-types ieee754 lens math-functions MissingH + monad-loops mtl numeric-limits openapi3 parallel regex-base + regex-pcre-builtin regex-tdfa scientific servant servant-openapi3 + servant-server split string-conversions swagger2 tabular + template-haskell text time vector wai wai-cors warp yaml + ]; + executableHaskellDepends = [ + aeson aeson-pretty attoparsec attoparsec-aeson base base-compat + bytestring containers Decimal deepseq dlist exceptions generic-lens + hashable http-types ieee754 lens math-functions MissingH + monad-loops mtl numeric-limits openapi3 parallel regex-base + regex-pcre-builtin regex-tdfa scientific servant servant-openapi3 + servant-server split string-conversions swagger2 tabular tasty + tasty-golden tasty-hspec tasty-hunit template-haskell text time + vector wai wai-cors warp yaml + ]; + testHaskellDepends = [ + aeson aeson-pretty attoparsec attoparsec-aeson base base-compat + bytestring containers Decimal deepseq dlist exceptions generic-lens + hashable http-types ieee754 lens math-functions MissingH + monad-loops mtl numeric-limits openapi3 parallel regex-base + regex-pcre-builtin regex-tdfa scientific servant servant-openapi3 + servant-server split string-conversions swagger2 tabular tasty + tasty-golden tasty-hspec tasty-hunit template-haskell text time + vector wai wai-cors warp yaml + ]; + homepage = "https://github.com/yellowbean/Hastructure#readme"; + description = "Cashflow modeling library for structured finance"; + license = lib.licenses.bsd3; + mainProgram = "Hastructure-exe"; +} diff --git a/README.md b/README.md index 33004a32..e45d3d69 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ [![Actions Status](https://github.com/yellowbean/Hastructure/workflows/Haskell%20CI/badge.svg)](https://github.com/yellowbean/Hastructure/actions) [![Docker Build](https://img.shields.io/docker/v/yellowbean/hastructure?color=green&label=docker)](https://hub.docker.com/r/yellowbean/hastructure) [![Pulls from DockerHub](https://img.shields.io/docker/pulls/yellowbean/hastructure.svg)](https://hub.docker.com/r/yellowbean/hastructure) +![Hackage Version](https://img.shields.io/hackage/v/Hastructure) # What is Hastructure ? @@ -82,10 +83,6 @@ * Misc * Support user define pay dates & pool collection dates -### Premium Support - - slack -> https://absboxhastructure.slack.com - ### Online Demo diff --git a/app/Main.hs b/app/Main.hs index c92a21d4..d3b40c73 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -32,7 +32,10 @@ import Data.Attoparsec.ByteString import Data.ByteString (ByteString) import Data.List import Data.Map +import Data.Either (fromLeft) +import qualified Data.Set as S import Data.Proxy +import Data.Time (getCurrentTime) import qualified Data.Text as T import Data.Maybe import Data.Yaml as Y @@ -59,6 +62,7 @@ import Types import MainBase import qualified Deal as D import qualified Deal.DealBase as DB +import qualified Deal.DealDate as DD import qualified Deal.DealMod as DM import qualified Deal.DealQuery as Q import qualified Asset as Ast @@ -100,78 +104,77 @@ debug = flip Debug.Trace.trace version1 :: Version -version1 = Version "0.45.7" +version1 = Version "0.50.1" -wrapRun :: DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp -wrapRun (MDeal d) mAssump mNonPerfAssump +wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp +wrapRun fs (MDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (MDeal _d,_pflow,_rs,_p) -- `debug` ("Run Done with deal->"++ show _d) -wrapRun (RDeal d) mAssump mNonPerfAssump + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (MDeal _d,_pflow,_rs,_p,_osPflow) +wrapRun fs (RDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (RDeal _d,_pflow,_rs,_p) -wrapRun (IDeal d) mAssump mNonPerfAssump + (_d,_pflow,_rs,_p,_osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (RDeal _d,_pflow,_rs,_p,_osPflow) +wrapRun fs (IDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (IDeal _d,_pflow,_rs,_p) -wrapRun (LDeal d) mAssump mNonPerfAssump + (_d,_pflow,_rs,_p,_osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (IDeal _d,_pflow,_rs,_p,_osPflow) +wrapRun fs (LDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (LDeal _d,_pflow,_rs,_p) -wrapRun (FDeal d) mAssump mNonPerfAssump + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (LDeal _d,_pflow,_rs,_p,_osPflow) +wrapRun fs (FDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (FDeal _d,_pflow,_rs,_p) -wrapRun (UDeal d) mAssump mNonPerfAssump + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (FDeal _d,_pflow,_rs,_p,_osPflow) +wrapRun fs (UDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (UDeal _d,_pflow,_rs,_p) -wrapRun (VDeal d) mAssump mNonPerfAssump + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (UDeal _d,_pflow,_rs,_p,_osPflow) +wrapRun fs (VDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (VDeal _d,_pflow,_rs,_p) -wrapRun (PDeal d) mAssump mNonPerfAssump + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (VDeal _d,_pflow,_rs,_p,_osPflow) +wrapRun fs (PDeal d) mAssump mNonPerfAssump = do - (_d,_pflow,_rs,_p) <- D.runDeal d D.DealPoolFlowPricing mAssump mNonPerfAssump - return (PDeal _d,_pflow,_rs,_p) + (_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump + return (PDeal _d,_pflow,_rs,_p,_osPflow) -wrapRun x _ _ = Left $ "RunDeal Failed ,due to unsupport deal type "++ show x +wrapRun _ x _ _ = Left $ "RunDeal Failed ,due to unsupport deal type "++ show x patchCumulativeToPoolRun :: RunPoolTypeRtn_ -> RunPoolTypeRtn_ patchCumulativeToPoolRun = Map.map - (\(CF.CashFlowFrame _ txns,stats) -> - (CF.CashFlowFrame (0,Lib.toDate "19000101",Nothing) (CF.patchCumulative (0,0,0,0,0,0) [] txns),stats)) + (\(CF.CashFlowFrame _ txns,mAssetFlow) -> + (CF.CashFlowFrame (0,Lib.toDate "19000101",Nothing) (CF.patchCumulative (0,0,0,0,0,0) [] txns),mAssetFlow)) -wrapRunPoolType :: PoolTypeWrap -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] -> RunPoolTypeRtn -wrapRunPoolType (MPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (LPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (IPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (RPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (FPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (VPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (PPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType (UPool pt) assump mRates = D.runPoolType pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) -wrapRunPoolType x _ _ = Left $ "RunPool Failed ,due to unsupport pool type "++ show x +wrapRunPoolType :: Bool -> PoolTypeWrap -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] -> RunPoolTypeRtn +wrapRunPoolType flag (MPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (LPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (IPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (RPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (FPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (VPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (PPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag (UPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates}) +wrapRunPoolType flag x _ _ = Left $ "RunPool Failed ,due to unsupport pool type "++ show x wrapRunAsset :: RunAssetReq -> RunAssetResp wrapRunAsset (RunAssetReq d assets Nothing mRates Nothing) = do cfs <- sequenceA $ (\a -> MA.calcAssetUnion a d mRates) <$> assets - return (P.aggPool Nothing [(cf,Map.empty) | cf <- cfs], Nothing) + return (fst (P.aggPool Nothing [(cf,Map.empty) | cf <- cfs]), Nothing) wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates Nothing) = do cfs <- sequenceA $ (\a -> MA.projAssetUnion a d assumps mRates) <$> assets - return (P.aggPool Nothing [(cf,Map.empty) | (cf,_) <- cfs] , Nothing) + return (fst (P.aggPool Nothing [(cf,Map.empty) | (cf,_) <- cfs]) , Nothing) wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates (Just pm)) - = - do + = do cfs <- sequenceA $ (\a -> MA.projAssetUnion a d assumps mRates) <$> assets pricingResult <- sequenceA $ (\a -> D.priceAssetUnion a d pm assumps mRates) <$> assets - let assetCf = P.aggPool Nothing cfs + let (assetCf,_) = P.aggPool Nothing cfs return (assetCf , Just pricingResult) -- Swagger API @@ -208,37 +211,58 @@ runAsset :: RunAssetReq -> Handler RunAssetResp runAsset req = return $ wrapRunAsset req runPool :: RunPoolReq -> Handler PoolRunResp -runPool (SingleRunPoolReq pt passumption mRates) +runPool (SingleRunPoolReq f pt passumption mRates) = return $ - patchCumulativeToPoolRun <$> (wrapRunPoolType pt passumption mRates) + patchCumulativeToPoolRun <$> (wrapRunPoolType f pt passumption mRates) runPoolScenarios :: RunPoolReq -> Handler (Map.Map ScenarioName PoolRunResp) -runPoolScenarios (MultiScenarioRunPoolReq pt mAssumps mRates) +runPoolScenarios (MultiScenarioRunPoolReq f pt mAssumps mRates) = return $ Map.map (\assump -> - patchCumulativeToPoolRun <$> (wrapRunPoolType pt (Just assump) mRates)) + patchCumulativeToPoolRun <$> (wrapRunPoolType f pt (Just assump) mRates)) mAssumps runDeal :: RunDealReq -> Handler RunResp -runDeal (SingleRunReq dt assump nonPerfAssump) - = return $ wrapRun dt assump nonPerfAssump +runDeal (SingleRunReq f dt assump nonPerfAssump) = return $ wrapRun f dt assump nonPerfAssump + -stressAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption -stressAssetPerf r (AP.MortgageAssump (Just da) mp mr ms) +-- Stressing default assumption from AssetPerfAssumption +stressDefaultAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption +stressDefaultAssetPerf r (AP.MortgageAssump (Just da) mp mr ms) = AP.MortgageAssump (Just (AP.stressDefaultAssump r da)) mp mr ms -stressAssetPerf r (AP.LoanAssump (Just da) mp mr ms) +stressDefaultAssetPerf r (AP.LoanAssump (Just da) mp mr ms) = AP.LoanAssump (Just (AP.stressDefaultAssump r da)) mp mr ms -stressAssetPerf r (AP.InstallmentAssump (Just da) mp mr ms) +stressDefaultAssetPerf r (AP.InstallmentAssump (Just da) mp mr ms) = AP.InstallmentAssump (Just (AP.stressDefaultAssump r da)) mp mr ms -stressAssetPerf r (AP.ReceivableAssump (Just da) mr ms) +stressDefaultAssetPerf r (AP.ReceivableAssump (Just da) mr ms) = AP.ReceivableAssump (Just (AP.stressDefaultAssump r da)) mr ms -stressAssetPerf _ x = x - -stressRevovlingPerf :: Rate -> Maybe AP.RevolvingAssumption -> Maybe AP.RevolvingAssumption -stressRevovlingPerf r Nothing = Nothing -stressRevovlingPerf r (Just (AP.AvailableAssets rp applyAssumpType)) - = Just (AP.AvailableAssets rp (over (AP.applyAssumptionTypeAssetPerf . _1) (stressAssetPerf r) applyAssumpType)) -stressRevovlingPerf r (Just (AP.AvailableAssetsBy m)) - = Just (AP.AvailableAssetsBy (Map.map (over (_2 . AP.applyAssumptionTypeAssetPerf . _1) (stressAssetPerf r)) m)) +stressDefaultAssetPerf r (AP.LeaseAssump (Just (AP.DefaultByContinuation dr)) mg mr me) + = AP.LeaseAssump (Just (AP.DefaultByContinuation (min 1.0 dr * r))) mg mr me +stressDefaultAssetPerf r (AP.LeaseAssump (Just (AP.DefaultByTermination dr)) mg mr me) + = AP.LeaseAssump (Just (AP.DefaultByTermination (min 1.0 dr * r))) mg mr me +stressDefaultAssetPerf _ x = x + +-- Stressing prepayment assumption from AssetPerfAssumption +stressPrepayAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption +stressPrepayAssetPerf r (AP.MortgageAssump da (Just mp) mr ms) + = AP.MortgageAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf r (AP.MortgageDeqAssump da (Just mp) mr ms) + = AP.MortgageDeqAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf r (AP.LoanAssump da (Just mp) mr ms) + = AP.LoanAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf r (AP.InstallmentAssump da (Just mp) mr ms) + = AP.InstallmentAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms +stressPrepayAssetPerf _ x = x + + + + +-- Stressing default assumption +stressRevovlingPerf :: (AP.AssetPerfAssumption -> AP.AssetPerfAssumption)-> Maybe AP.RevolvingAssumption -> Maybe AP.RevolvingAssumption +stressRevovlingPerf f Nothing = Nothing +stressRevovlingPerf f (Just (AP.AvailableAssets rp applyAssumpType)) + = Just (AP.AvailableAssets rp (over (AP.applyAssumptionTypeAssetPerf . _1) f applyAssumpType)) +stressRevovlingPerf f (Just (AP.AvailableAssetsBy m)) + = Just (AP.AvailableAssetsBy (Map.map (over (_2 . AP.applyAssumptionTypeAssetPerf . _1) f) m)) modifyDealType :: DM.ModifyType -> Double -> DealType -> DealType modifyDealType dm f (MDeal d) = MDeal $ DM.modDeal dm f d @@ -260,6 +284,17 @@ queryDealType (UDeal _d) = Q.queryCompound _d queryDealType (VDeal _d) = Q.queryCompound _d queryDealType (PDeal _d) = Q.queryCompound _d +queryClosingDate :: DealType -> Either String Date +queryClosingDate (MDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (RDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (IDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (LDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (FDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (UDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (VDeal _d) = DD.getClosingDate (DB.dates _d) +queryClosingDate (PDeal _d) = DD.getClosingDate (DB.dates _d) + + queryDealTypeBool :: DealType -> Date -> DealStats -> Either String Bool queryDealTypeBool (MDeal _d) d s = Q.queryDealBool _d s d queryDealTypeBool (RDeal _d) d s = Q.queryDealBool _d s d @@ -270,6 +305,16 @@ 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 +testDealTypeBool :: DealType -> Date -> Pre -> Either String Bool +testDealTypeBool (MDeal _d) d p = Q.testPre d _d p +testDealTypeBool (RDeal _d) d p = Q.testPre d _d p +testDealTypeBool (IDeal _d) d p = Q.testPre d _d p +testDealTypeBool (LDeal _d) d p = Q.testPre d _d p +testDealTypeBool (FDeal _d) d p = Q.testPre d _d p +testDealTypeBool (UDeal _d) d p = Q.testPre d _d p +testDealTypeBool (VDeal _d) d p = Q.testPre d _d p +testDealTypeBool (PDeal _d) d p = Q.testPre d _d p + getDealBondMap :: DealType -> Map.Map BondName L.Bond getDealBondMap (MDeal d) = DB.bonds d getDealBondMap (RDeal d) = DB.bonds d @@ -290,104 +335,140 @@ 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 -- `debug` ("running stress "++ show stressed) +doTweak :: Double -> RootFindTweak -> DealRunInput -> DealRunInput +doTweak r (StressPoolDefault _) (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) + = let + stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressDefaultAssetPerf (toRational r)) assumps + stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressDefaultAssetPerf (toRational r)) mRevolving } in - case runResult of - Right (d,mPoolCfMap,mResult,mPricing) -> - let - bondBal = L.getOutstandingAmount $ (getDealBondMap d) Map.! bn - in - (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,Bool,Bool) -> Double -> Double -testBySpread (dt,mPAssump,runAssump) (bn,otherBondFlag,otherFeeFlag) f + (dt ,Just stressed, stressedNonPerf, f) + +doTweak r (StressPoolPrepayment _) (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) = let - runResult = wrapRun (modifyDealType (DM.AddSpreadToBonds bn) f dt) mPAssump runAssump + stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressPrepayAssetPerf (toRational r)) assumps + stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressPrepayAssetPerf (toRational r)) mRevolving } + in + (dt ,Just stressed, stressedNonPerf, f) + +doTweak r (MaxSpreadTo bn _) (dt , mAssump, rAssump, f) + = (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump, f) + +doTweak r (SplitFixedBalance bn1 bn2 _) (dt , mAssump, rAssump, f) + = (modifyDealType (DM.SlideBalances bn1 bn2) r dt , mAssump, rAssump, f) + + +evalRootFindStop :: RootFindStop -> RunRespRight -> Double +evalRootFindStop (BondIncurLoss bn) (dt,_,_,_,osPflow) + = let + bondBal = L.getOutstandingAmount $ getDealBondMap dt Map.! bn + in + (fromRational . toRational) $ bondBal - 0.01 + +evalRootFindStop (BondIncurIntLoss bn threshold) (dt,_,_,_,osPflow) + = let + dueIntAmt = L.getTotalDueInt $ getDealBondMap dt Map.! bn + in + (fromRational . toRational) $ threshold - (dueIntAmt-0.01) + +evalRootFindStop (BondIncurPrinLoss bn threshold) (dt,_,_,_,osPflow) + = let + duePrinAmt = L.getCurBalance $ getDealBondMap dt Map.! bn + in + (fromRational . toRational) $ threshold - (duePrinAmt-0.01) + +evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_,pResult,osPflow) + = 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 + bondBal = L.getOriginBalance $ getDealBondMap dt Map.! bn + v = maybe bondBal getPriceValue $ Map.lookup bn pResult -- TODO shortcut to avoid error + in + if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0 then + -1 + else + (fromRational . toRational) $ bondBal - v + +evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult,osPflow) + = let + v = L.extractIrrResult $ pResult Map.! bn + in + case v of + Nothing -> -1 -- `debug` ("No IRR found for bond:"++ show bn) + Just irr -> (fromRational . toRational) $ irr - target -- `debug` ("IRR for bond:"++ show target ++" is "++ show irr) + +evalRootFindStop (BalanceFormula ds targetBal) (dt,collectedFlow,logs,_,osPflow) + = let + _date = case find (\(EndRun d msg) -> True) (reverse logs) of + Just (EndRun (Just d) _ ) -> d + Nothing -> case queryClosingDate dt of + Right d' -> d' + Left err -> error $ "Error in BalanceFormula: " ++ err + v = case queryDealType dt _date (Q.patchDateToStats _date ds) of + Right v' -> fromRational v' + Left err -> error $ "Error in BalanceFormula: " ++ err + in + (fromRational . toRational) $ v - targetBal -- `debug` ("querydate" ++ show _date++"iteration" ++ show v ++ " target:" ++ show targetBal ++ ">> " ++ show ( v- targetBal)) + + + +rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double +rootFindAlgo (dt ,poolAssumps, runAssumps, f) tweak stop r + = let + (dt' ,poolAssumps', runAssumps', f) = doTweak r tweak (dt ,poolAssumps, runAssumps, f) in - case runResult of - 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 - bondBal = L.getOriginBalance $ (getDealBondMap dt) Map.! bn - in - if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0 then - -1 - else - (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 + case wrapRun f dt' poolAssumps' runAssumps' of + Right runRespRight -> evalRootFindStop stop runRespRight -- `debug` ("RootFinder with f" ++ show r++ "with assumpt" ++ show poolAssumps') + Left errorMsg -> -1 runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp) -runRootFinderBy (FirstLossReq (dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}) bn) +runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving},f) tweak stop) = return $ let - itertimes = 500 - def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.0001} + itertimes = 1000 + def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.000001} + riddersFn = case tweak of + SplitFixedBalance _ _ (l,h) -> ridders def (min h 0.99, max l 0.00001) + StressPoolDefault (l,h) -> ridders def (h ,max l 0.00) + StressPoolPrepayment (l,h) -> ridders def (h ,max l 0.00) + MaxSpreadTo _ (l,h) -> ridders def (h ,max l 0.00) + _ -> error ("Unsupported tweak for root finder" ++ show tweak) in - case ridders def (500.0,0.00) (testByDefault dt assumps nonPerfAssump bn) of - Root r -> Right $ - FirstLossResult - r - (over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressAssetPerf (toRational r)) assumps) - (stressRevovlingPerf (toRational r) mRevolving) - NotBracketed -> Left "Not able to bracket the root" - SearchFailed -> Left "Not able to find the root" - -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) (bns,chkOtherBnds,chkOtherFees)) of - Root r -> let - dt' = modifyDealType (DM.AddSpreadToBonds bns) r dt - in - Right $ BestSpreadResult r (getDealBondMap dt') dt' + case riddersFn (rootFindAlgo req tweak stop) of + Root r -> Right $ RFResult r (doTweak r tweak req) NotBracketed -> Left "Not able to bracket the root" SearchFailed -> Left "Not able to find the root" runDealScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) -runDealScenarios (MultiScenarioRunReq dt mAssumps nonPerfAssump) - = return $ Map.map (\singleAssump -> wrapRun dt (Just singleAssump) nonPerfAssump) mAssumps +runDealScenarios (MultiScenarioRunReq f dt mAssumps nonPerfAssump) + = return $ Map.map (\singleAssump -> wrapRun f dt (Just singleAssump) nonPerfAssump) mAssumps runMultiDeals :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) -runMultiDeals (MultiDealRunReq mDts assump nonPerfAssump) - = return $ Map.map (\singleDealType -> wrapRun singleDealType assump nonPerfAssump) mDts +runMultiDeals (MultiDealRunReq f mDts assump nonPerfAssump) + = return $ Map.map (\singleDealType -> wrapRun f singleDealType assump nonPerfAssump) mDts runDate :: RunDateReq -> Handler [Date] -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 +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 runDealByRunScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) -runDealByRunScenarios (MultiRunAssumpReq dt mAssump nonPerfAssumpMap) - = return $ Map.map (wrapRun dt mAssump) nonPerfAssumpMap +runDealByRunScenarios (MultiRunAssumpReq f dt mAssump nonPerfAssumpMap) + = return $ Map.map (wrapRun f dt mAssump) nonPerfAssumpMap runDealByCombo :: RunDealReq -> Handler (Map.Map String RunResp) -runDealByCombo (MultiComboReq dMap assumpMap nonPerfAssumpMap) +runDealByCombo (MultiComboReq f dMap assumpMap nonPerfAssumpMap) = let dList = Map.toList dMap aList = Map.toList assumpMap nList = Map.toList nonPerfAssumpMap - r = [ (intercalate "^" [dk,ak,nk], wrapRun d a n) | (dk,d) <- dList, (ak,a) <- aList, (nk,n) <- nList ] + r = [ (intercalate "^" [dk,ak,nk], wrapRun f d a n) | (dk,d) <- dList, (ak,a) <- aList, (nk,n) <- nList ] rMap = Map.fromList r in return rMap @@ -423,9 +504,10 @@ main = do writeSwaggerJSON config <- BS.readFile "config.yml" + curTime <- getCurrentTime let mc = Y.decodeEither' config :: Either ParseException Config let (Config _p) = case mc of Left exp -> Config 8081 Right c -> c - print ("Engine start with version:"++ _version version1++";running at Port:"++ show _p) - run _p app \ No newline at end of file + print (show curTime ++ ">> Engine start with version:"++ _version version1++";running at Port:"++ show _p) + run _p app diff --git a/app/MainBase.hs b/app/MainBase.hs index 50e7e143..639cf880 100644 --- a/app/MainBase.hs +++ b/app/MainBase.hs @@ -15,8 +15,8 @@ module MainBase(DealType(..),RunResp,PoolTypeWrap(..),RunPoolTypeRtn,RunPoolTypeRtn_ ,RunAssetReq(..),RunAssetResp,ScenarioName,DealRunInput,RunDealReq(..),RunSimDealReq(..),RunPoolReq(..) - ,RunDateReq(..),Version(..) - ,RootFindReq(..),RootFindResp(..),TargetBonds,PoolRunResp + ,RunDateReq(..),Version(..),RunRespRight + ,RootFindReq(..),RootFindResp(..),TargetBonds,PoolRunResp,RootFindTweak(..),RootFindStop(..) ) where @@ -121,7 +121,7 @@ data PoolTypeWrap = LPool (DB.PoolType AB.Loan) deriving(Show, Generic) -type RunPoolTypeRtn_ = Map.Map PoolId (CF.CashFlowFrame, Map.Map CutoffFields Balance) +type RunPoolTypeRtn_ = Map.Map PoolId CF.PoolCashflow type RunPoolTypeRtn = Either String RunPoolTypeRtn_ @@ -129,26 +129,26 @@ type RunPoolTypeRtn = Either String RunPoolTypeRtn_ data RunAssetReq = RunAssetReq Date [AB.AssetUnion] (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) (Maybe PricingMethod) deriving(Show, Generic) -type RunAssetResp = Either String ((CF.CashFlowFrame, Map.Map CutoffFields Balance), Maybe [PriceResult]) +type RunAssetResp = Either String (CF.AssetCashflow, Maybe [PriceResult]) type ScenarioName = String -type DealRunInput = (DealType, Maybe AP.ApplyAssumptionType, AP.NonPerfAssumption) -data RunDealReq = SingleRunReq DealType (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption - | MultiScenarioRunReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption --- multi pool perf - | MultiDealRunReq (Map.Map ScenarioName DealType) (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption -- multi deal struct - | MultiRunAssumpReq DealType (Maybe AP.ApplyAssumptionType) (Map.Map ScenarioName AP.NonPerfAssumption) -- multi run assump - | MultiComboReq (Map.Map ScenarioName DealType) (Map.Map ScenarioName (Maybe AP.ApplyAssumptionType)) (Map.Map ScenarioName AP.NonPerfAssumption) +type DealRunInput = (DealType, Maybe AP.ApplyAssumptionType, AP.NonPerfAssumption, [D.ExpectReturn]) +data RunDealReq = SingleRunReq [D.ExpectReturn] DealType (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption + | MultiScenarioRunReq [D.ExpectReturn] DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption --- multi pool perf + | MultiDealRunReq [D.ExpectReturn] (Map.Map ScenarioName DealType) (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption -- multi deal struct + | MultiRunAssumpReq [D.ExpectReturn] DealType (Maybe AP.ApplyAssumptionType) (Map.Map ScenarioName AP.NonPerfAssumption) -- multi run assump + | MultiComboReq [D.ExpectReturn] (Map.Map ScenarioName DealType) (Map.Map ScenarioName (Maybe AP.ApplyAssumptionType)) (Map.Map ScenarioName AP.NonPerfAssumption) deriving(Show, Generic) data RunSimDealReq = OASReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption deriving(Show, Generic) -type RunResp = Either String (DealType , Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent],Map.Map String PriceResult) +type RunRespRight = (DealType , Map.Map PoolId CF.CashFlowFrame, [ResultComponent],Map.Map String PriceResult, Map.Map PoolId CF.PoolCashflow) +type RunResp = Either String RunRespRight - -data RunPoolReq = SingleRunPoolReq PoolTypeWrap (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) - | MultiScenarioRunPoolReq PoolTypeWrap (Map.Map ScenarioName AP.ApplyAssumptionType) (Maybe [RateAssumption]) +data RunPoolReq = SingleRunPoolReq Bool PoolTypeWrap (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) + | MultiScenarioRunPoolReq Bool PoolTypeWrap (Map.Map ScenarioName AP.ApplyAssumptionType) (Maybe [RateAssumption]) deriving(Show, Generic) @@ -156,11 +156,7 @@ data RunDateReq = RunDateReq Date DatePattern (Maybe Date) deriving(Show, Generic) instance ToSchema RunDateReq -type PoolRunResp = Either String (Map.Map PoolId (CF.CashFlowFrame, Map.Map CutoffFields Balance)) - -data RootFindResp = FirstLossResult Double AP.ApplyAssumptionType (Maybe AP.RevolvingAssumption) - | BestSpreadResult Double (Map.Map BondName L.Bond) DealType - deriving(Show, Generic) +type PoolRunResp = Either String (Map.Map PoolId CF.PoolCashflow) type TargetBonds = [BondName] @@ -169,11 +165,37 @@ type TargetBonds = [BondName] --- 2. make sure WAC cap is met data RootFindReq = FirstLossReq DealRunInput BondName | MaxSpreadToFaceReq DealRunInput BondName Bool Bool + | RootFinderReq DealRunInput RootFindTweak RootFindStop deriving(Show, Generic) -instance ToSchema RootFindReq +type RangeInput = (Double, Double) -- (min, max) +data RootFindTweak = StressPoolDefault RangeInput -- stressed pool perf + | StressPoolPrepayment RangeInput -- stressed pool prepayment + | MaxSpreadTo BondName RangeInput -- bond component + | SplitFixedBalance BondName BondName RangeInput -- bond component + deriving(Show, Generic) +data RootFindStop = BondIncurLoss BondName + | BondIncurPrinLoss BondName Balance + | BondIncurIntLoss BondName Balance + | BondPricingEqOriginBal BondName Bool Bool + | BondMetTargetIrr BondName IRR + | BalanceFormula DealStats Balance + deriving(Show, Generic) + +data RootFindResp = RFResult Double DealRunInput + -- | BestSpreadResult Double (Map.Map BondName L.Bond) DealType + -- | FirstLossResult Double AP.ApplyAssumptionType (Maybe AP.RevolvingAssumption) + deriving(Show, Generic) + +$(deriveJSON defaultOptions ''RootFindTweak) +$(deriveJSON defaultOptions ''RootFindStop) + +instance ToSchema D.ExpectReturn +instance ToSchema RootFindReq +instance ToSchema RootFindTweak +instance ToSchema RootFindStop instance ToSchema CF.CashFlowFrame instance ToSchema AB.Loan instance ToSchema AB.Installment @@ -271,6 +293,7 @@ instance ToSchema (TsPoint AP.RefiEvent) instance ToSchema AP.RefiEvent instance ToSchema AP.InspectType instance ToSchema AP.CallOpt +instance ToSchema AP.StopBy instance ToSchema AP.NonPerfAssumption instance ToSchema BondPricingMethod instance ToSchema AP.TradeType @@ -343,4 +366,4 @@ instance ToSchema RunDealReq instance ToSchema PoolTypeWrap instance ToSchema RunPoolReq instance ToSchema RunAssetReq -instance ToSchema RootFindResp \ No newline at end of file +instance ToSchema RootFindResp diff --git a/build.nix b/build.nix new file mode 100644 index 00000000..73fe7c97 --- /dev/null +++ b/build.nix @@ -0,0 +1,10 @@ +{ nixpkgs ? import (fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/refs/tags/25.05.tar.gz"; + sha256 = "1915r28xc4znrh2vf4rrjnxldw2imysz819gzhk9qlrkqanmfsxd"; # Replace with actual hash + }) {} +}: +let + # Use the Haskell package set from nixpkgs + haskellPackages = nixpkgs.haskellPackages; +in + haskellPackages.callCabal2nix "Hastructure" ./. {} diff --git a/release.nix b/release.nix new file mode 100644 index 00000000..0ef4bd40 --- /dev/null +++ b/release.nix @@ -0,0 +1,30 @@ +{ nixpkgs ? import (fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/refs/tags/25.05.tar.gz"; + sha256 = "1915r28xc4znrh2vf4rrjnxldw2imysz819gzhk9qlrkqanmfsxd"; # Replace with actual hash + }) {} +}: +let + # Use the Haskell package set from nixpkgs + haskellPackages = nixpkgs.haskellPackages; + + # Define the project + hastructure = haskellPackages.callCabal2nix "Hastructure" ./. {}; +in +{ + # Expose the project derivation + hastructure = hastructure; + + # Development shell for interactive work + shell = haskellPackages.shellFor { + packages = p: [hastructure]; + buildInputs = with haskellPackages; [ + cabal-install + ghc + haskell-language-server + ]; + }; + + installPhase = '' + cp config.yaml $out/bin/ + }; +} diff --git a/src/Analytics.hs b/src/Analytics.hs index e2a737a4..30d85644 100644 --- a/src/Analytics.hs +++ b/src/Analytics.hs @@ -155,16 +155,17 @@ calcRequiredAmtForIrrAtDate irr ds vs d = def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.00000001} in case ridders def (0.0001,100000000000000) (calcPvFromIRR irr ds vs d) of - Root finalAmt -> Just (fromRational (toRational finalAmt)) - _ -> Nothing + Root finalAmt -> Just (fromRational (toRational finalAmt)) + _ -> Nothing -- ^ calc IRR from a cashflow calcIRR :: [Date] -> [Amount] -> Either String Rate calcIRR _ [] = Left "No cashflow amount" calcIRR [] _ = Left "No cashflow date" calcIRR ds vs - | all (> 0) vs = Left "All cashflow can't be all positive" - | all (< 0) vs = Left "All cashflow can't be all negative" + | all (>= 0) vs = Left $ "All cashflow can't be all positive:"++ show vs + | all (<= 0) vs = Left $ "All cashflow can't be all negative:"++ show vs + | all (== 0) vs = Left "All cashflow can't be all zeros" | otherwise = let itertimes = 1000 @@ -174,6 +175,6 @@ calcIRR ds vs sumOfPv irr = pv22 irr beginDate ds vs' in case ridders def (-1,1000) sumOfPv of - Root irrRate -> Right $ 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 + Root irrRate -> Right $ 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 diff --git a/src/Asset.hs b/src/Asset.hs index bde510f4..16018077 100644 --- a/src/Asset.hs +++ b/src/Asset.hs @@ -8,9 +8,9 @@ module Asset ( Asset(..), buildAssumptionPpyDefRecRate,buildAssumptionPpyDelinqDefRecRate - ,calcRecoveriesFromDefault + ,calcRecoveriesFromDefault,getCurBalance ,priceAsset,applyHaircut,buildPrepayRates,buildDefaultRates,getObligorFields - ,getObligorTags,getObligorId,getRecoveryLagAndRate,getDefaultDelinqAssump + ,getObligorTags,getObligorId,getRecoveryLagAndRate,getDefaultDelinqAssump,getOriginInfo ) where import qualified Data.Time as T @@ -215,6 +215,7 @@ buildPrepayRates a ds mPa = buildDefaultRates :: Asset b => b -> [Date] -> Maybe A.AssetDefaultAssumption -> Either String [Rate] buildDefaultRates _ ds Nothing = Right $ replicate (pred (length ds)) 0.0 +buildDefaultRates a [] mDa = Left "buildDefaultRates: empty date list" buildDefaultRates a ds mDa = normalPerfVector <$> case mDa of diff --git a/src/AssetClass/AssetBase.hs b/src/AssetClass/AssetBase.hs index 81fe6b27..c8afcb3d 100644 --- a/src/AssetClass/AssetBase.hs +++ b/src/AssetClass/AssetBase.hs @@ -54,16 +54,6 @@ data AmortPlan = Level -- ^ for mortgage / french system -> -- | calculate period payment (Annuity/Level mortgage) calcPmt :: Balance -> IRate -> Int -> Amount --- calcPmt bal 0.0 periods = divideBI bal periods --- calcPmt bal periodRate periods = --- let --- periodRate1 = toRational periodRate --- r1 = ((1+periodRate1)^^periods) / ((1+periodRate1)^^periods-1) -- `debug` ("PR>>"++show periodRate) --- pmtFactor = periodRate1 * r1 -- `debug` ("R1>>"++ show r1) --- in --- mulBR bal pmtFactor -- `debug` ("Factor"++ show pmtFactor) - --- Generate by gork calcPmt bal rate periods | rate == 0.0 = divideBI bal periods | otherwise = let rate' = realToFrac rate :: Double diff --git a/src/AssetClass/Lease.hs b/src/AssetClass/Lease.hs index 6e25365c..10f90ac5 100644 --- a/src/AssetClass/Lease.hs +++ b/src/AssetClass/Lease.hs @@ -91,7 +91,7 @@ nextLease :: Lease -> (AP.LeaseAssetRentAssump, TermChangeRate, DayGap) -> (Leas nextLease l@(RegularLease (LeaseInfo sd ot rental ob) bal rt _) (rAssump,tc,gd) = let leaseEndDate = last $ getPaymentDates l 0 - nextStartDate = T.addDays (succ (toInteger gd)) leaseEndDate -- `debug` ("Gap Day ->"++ show gd) + nextStartDate = T.addDays (succ (toInteger gd)) leaseEndDate nextOriginTerm = round $ mulIR ot (1+tc) nextEndDate = calcEndDate nextStartDate ot rental @@ -102,7 +102,7 @@ nextLease l@(RegularLease (LeaseInfo sd ot rental ob) bal rt _) (rAssump,tc,gd) newBal nextOriginTerm Current ,nextEndDate ,(newRassump,tc,gd) - ) -- `debug` ("1+tc"++show (1+tc) ++">>"++ show (mulIR ot (1+tc))) + ) nextLease l@(StepUpLease (LeaseInfo sd ot rental ob) lsteupInfo bal rt _) (rAssump,tc,gd) = let @@ -133,6 +133,19 @@ nextLeaseTill l (rsc,tc,mg) lastDate (AP.StopByExtTimes n) accum where (new_lease,new_lastDate, newAssump) = nextLease l (rsc,tc,mg) +nextLeaseTill l (rsc,tc,mg) lastDate (AP.EarlierOf ed n) accum + | lastDate >= ed = accum + | n == 0 = accum + | otherwise = nextLeaseTill new_lease newAssump new_lastDate (AP.EarlierOf ed (pred n)) (accum++[new_lease]) + where + (new_lease,new_lastDate, newAssump) = nextLease l (rsc,tc,mg) + +nextLeaseTill l (rsc,tc,mg) lastDate (AP.LaterOf ed n) accum + | lastDate >= ed && n == 0 = accum + | otherwise = nextLeaseTill new_lease newAssump new_lastDate (AP.LaterOf ed (pred n)) (accum++[new_lease]) + where + (new_lease,new_lastDate, newAssump) = nextLease l (rsc,tc,mg) + -- ^ calculate the daily rate for a step up lease calcPmts :: LeaseStepUp -> [Rate] -> Amount -> Either String [Amount] calcPmts (FlatRate _r) fs amt = Right (scanl mulBR amt (replicate (length fs) _r)) diff --git a/src/AssetClass/Receivable.hs b/src/AssetClass/Receivable.hs index a9c51472..7845ea5d 100644 --- a/src/AssetClass/Receivable.hs +++ b/src/AssetClass/Receivable.hs @@ -36,16 +36,22 @@ import qualified Asset as A debug = flip trace -buildRecoveryCfs :: StartDate -> Balance -> Maybe A.RecoveryAssumption -> [CF.TsRow] -buildRecoveryCfs _ _ Nothing = [] +-- project recovery cashflow from recovery assumption and defaulted balance +buildRecoveryCfs :: StartDate -> Balance -> Maybe A.RecoveryAssumption -> Either String [CF.TsRow] +buildRecoveryCfs _ _ Nothing = Right [] buildRecoveryCfs sd defaultedBal (Just (A.RecoveryByDays r dists)) = let totalRecoveryAmt = mulBR defaultedBal r - recoveryAmts = mulBR totalRecoveryAmt <$> (snd <$> dists) - recoveryDates = (\x -> T.addDays (toInteger x)) <$> (fst <$> dists) <*> [sd] - lossAmts = (take (pred (length recoveryDates)) (repeat 0)) ++ [defaultedBal - totalRecoveryAmt] - in - [ CF.ReceivableFlow d 0 0 0 0 0 amt lossAmt Nothing | (amt,d,lossAmt) <- zip3 recoveryAmts recoveryDates lossAmts] + recoveryDistribution = snd <$> dists + in + case sum recoveryDistribution of + 1 -> let + recoveryAmts = mulBR totalRecoveryAmt <$> recoveryDistribution + recoveryDates = (\x -> T.addDays (toInteger x)) <$> (fst <$> dists) <*> [sd] + lossAmts = replicate (pred (length recoveryDates)) 0 ++ [defaultedBal - totalRecoveryAmt] + in + Right $ [ CF.ReceivableFlow d 0 0 0 0 0 amt lossAmt Nothing | (amt,d,lossAmt) <- zip3 recoveryAmts recoveryDates lossAmts] + _ -> Left $ "Recovery distribution does not sum up to 1, got " ++ show (sum recoveryDistribution) ++ " for " ++ show dists calcDueFactorFee :: Receivable -> Date -> Balance @@ -56,17 +62,17 @@ calcDueFactorFee r@(Invoice (ReceivableInfo sd ob oa dd ft obr) st) asOfDay Just (FixedRateFee r) -> mulBR ob r Just (FactorFee r daysInPeriod rnd) -> let - periods = case rnd of - Up -> ceiling ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int - Down -> floor ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int + periods = case rnd of + Up -> ceiling ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int + Down -> floor ((fromIntegral (daysBetween sd dd)) / (fromIntegral daysInPeriod)) :: Int in - fromRational $ (toRational periods) * toRational (mulBR ob r) + fromRational $ (toRational periods) * toRational (mulBR ob r) Just (AdvanceFee r) -> mulBR oa (r * (yearCountFraction DC_ACT_365F sd dd)) Just (CompoundFee fs) -> let - newReceivables = [ Invoice (ReceivableInfo sd ob oa dd (Just newFeeType) obr) st | newFeeType <- fs] + newReceivables = [ Invoice (ReceivableInfo sd ob oa dd (Just newFeeType) obr) st | newFeeType <- fs] in - sum $ (`calcDueFactorFee` asOfDay) <$> newReceivables + sum $ (`calcDueFactorFee` asOfDay) <$> newReceivables instance Asset Receivable where @@ -106,7 +112,7 @@ instance Asset Receivable where Invoice (ReceivableInfo newDate ob oa (T.addDays gaps newDate) ft obr) st splitWith r@(Invoice (ReceivableInfo sd ob oa dd ft obr) st) rs - = [ (Invoice (ReceivableInfo sd (mulBR ob ratio) (mulBR oa ratio) dd ft obr) st) | ratio <- rs ] + = [ Invoice (ReceivableInfo sd (mulBR ob ratio) (mulBR oa ratio) dd ft obr) st | ratio <- rs ] -- Defaulted Invoice projCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) (Defaulted _)) @@ -121,23 +127,27 @@ instance Asset Receivable where (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) - -- Performing Invoice + -- Performing Invoice : default all balance at end of due date projCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) Current) asOfDay massump@(A.ReceivableAssump (Just A.DefaultAtEnd) amr ams, _ , _) mRates - = Right $ (CF.CashFlowFrame (ob,asOfDay,Nothing) futureTxns, historyM) - where - payDate = dd - feeDue = calcDueFactorFee r payDate - -- initTxn = [CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing] + = let + payDate = dd + feeDue = calcDueFactorFee r payDate + -- initTxn = [CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing] - realizedLoss = case amr of - Nothing -> ob - Just _ -> 0 - txns = [CF.ReceivableFlow payDate 0 0 0 0 ob 0 realizedLoss Nothing] - (futureTxns,historyM)= CF.cutoffTrs asOfDay $ txns++(buildRecoveryCfs payDate ob amr) + realizedLoss = case amr of + Nothing -> ob + Just _ -> 0 + txns = [CF.ReceivableFlow payDate 0 0 0 0 ob 0 realizedLoss Nothing] + in + do + recoveryFlow <- buildRecoveryCfs payDate ob amr + let (futureTxns,historyM) = CF.cutoffTrs asOfDay $ txns++recoveryFlow + return $ (CF.CashFlowFrame (ob,asOfDay,Nothing) futureTxns, historyM) + -- Performing Invoice : projCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) Current) asOfDay massump@(A.ReceivableAssump amd amr ams, _ , _) @@ -151,7 +161,7 @@ instance Asset Receivable where defaultRates <- A.buildDefaultRates r (sd:[dd]) amd let defaultAmt = mulBR ob (head defaultRates) let afterDefaultBal = ob - defaultAmt - let afterDefaultFee = mulBR feeDue (1 - (head defaultRates)) + let afterDefaultFee = mulBR feeDue (1 - head defaultRates) let feePaid = min afterDefaultBal afterDefaultFee let principal = max 0 $ afterDefaultBal - feePaid @@ -161,7 +171,8 @@ instance Asset Receivable where Just _ -> 0 let txns = [initTxn, CF.ReceivableFlow payDate 0 0 principal feePaid defaultAmt 0 realizedLoss Nothing] - let (futureTxns,historyM) = CF.cutoffTrs asOfDay $ txns++(buildRecoveryCfs payDate defaultAmt amr) -- `debug` ("recovery flow"++ show (buildRecoveryCfs payDate defaultAmt amr)) + recoveryFlow <- buildRecoveryCfs payDate defaultAmt amr + let (futureTxns,historyM) = CF.cutoffTrs asOfDay $ txns++recoveryFlow return $ (CF.CashFlowFrame (ob,asOfDay,Nothing) futureTxns, historyM) projCashflow a b c d = Left $ "Failed to match when proj receivable with assumption >>" ++ show a ++ show b ++ show c ++ show d diff --git a/src/Assumptions.hs b/src/Assumptions.hs index bb6e64f8..3fc7d240 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -15,13 +15,13 @@ module Assumptions (BondPricingInput(..),IrrType(..) ,NonPerfAssumption(..),AssetPerf ,AssetDelinquencyAssumption(..) ,AssetDelinqPerfAssumption(..),AssetDefaultedPerfAssumption(..) - ,calcResetDates,IssueBondEvent(..) + ,IssueBondEvent(..) ,TagMatchRule(..),ObligorStrategy(..),RefiEvent(..),InspectType(..) ,FieldMatchRule(..),CallOpt(..) ,_MortgageAssump,_MortgageDeqAssump,_LeaseAssump,_LoanAssump,_InstallmentAssump ,_ReceivableAssump,_FixedAssetAssump ,stressDefaultAssump,applyAssumptionTypeAssetPerf,TradeType(..) - ,LeaseEndType(..),LeaseDefaultType(..) + ,LeaseEndType(..),LeaseDefaultType(..),stressPrepaymentAssump,StopBy(..) ) where @@ -83,8 +83,8 @@ data ObligorStrategy = ObligorById [String] AssetPerf data ApplyAssumptionType = PoolLevel AssetPerf -- ^ assumption apply to all assets in the pool | ByIndex [StratPerfByIdx] -- ^ assumption which only apply to a set of assets in the pool | ByName (Map.Map PoolId AssetPerf) -- ^ assumption for a named pool - | ByObligor [ObligorStrategy] | ByPoolId (Map.Map PoolId ApplyAssumptionType) -- ^ assumption for a pool + | ByObligor [ObligorStrategy] -- ^ assumption for a set of obligors | ByDealName (Map.Map DealName (ApplyAssumptionType, NonPerfAssumption)) -- ^ assumption for a named deal deriving (Show, Generic) @@ -126,8 +126,14 @@ data CallOpt = LegacyOpts [C.CallOption] -- ^ legacy support | CallOnDates DatePattern [Pre] -- ^ test call at end of day deriving (Show, Generic, Read, Ord, Eq) +data StopBy = StopByDate Date -- ^ stop by date + | StopByPre DatePattern [Pre] -- ^ stop by precondition + deriving (Show, Generic, Read) + + data NonPerfAssumption = NonPerfAssumption { - stopRunBy :: Maybe Date -- ^ optional stop day,which will stop cashflow projection + -- stopRunBy :: Maybe Date -- ^ optional stop day,which will stop cashflow projection + stopRunBy :: Maybe StopBy -- ^ optional stop day,which will stop cashflow projection ,projectedExpense :: Maybe [(FeeName,Ts)] -- ^ optional expense projection ,callWhen :: Maybe [CallOpt] -- ^ optional call options set, once any of these were satisfied, then clean up waterfall is triggered ,revolving :: Maybe RevolvingAssumption -- ^ optional revolving assumption with revoving assets @@ -164,8 +170,18 @@ stressDefaultAssump x (DefaultVec rs) = DefaultVec $ capWith 1.0 ((x*) <$> rs) stressDefaultAssump x (DefaultVecPadding rs) = DefaultVecPadding $ capWith 1.0 ((x*) <$> rs) stressDefaultAssump x (DefaultByAmt (b,rs)) = DefaultByAmt (mulBR b x, rs) stressDefaultAssump x (DefaultAtEndByRate r1 r2) = DefaultAtEndByRate (min 1.0 (r1*x)) (min 1.0 (r2*x)) -stressDefaultAssump x (DefaultByTerm rss) = DefaultByTerm $ ((capWith 1.0) <$> (map (map (* x)) rss)) stressDefaultAssump x (DefaultStressByTs ts a) = DefaultStressByTs ts (stressDefaultAssump x a) +stressDefaultAssump x (DefaultByTerm rss) = DefaultByTerm $ ((capWith 1.0) <$> (map (map (* x)) rss)) + +stressPrepaymentAssump :: Rate -> AssetPrepayAssumption -> AssetPrepayAssumption +stressPrepaymentAssump x (PrepaymentConstant r) = PrepaymentConstant $ min 1.0 (r*x) +stressPrepaymentAssump x (PrepaymentCPR r) = PrepaymentCPR $ min 1.0 (r*x) +stressPrepaymentAssump x (PrepaymentVec rs) = PrepaymentVec $ capWith 1.0 ((x*) <$> rs) +stressPrepaymentAssump x (PrepaymentVecPadding rs) = PrepaymentVecPadding $ capWith 1.0 ((x*) <$> rs) +stressPrepaymentAssump x (PrepayByAmt (b,rs)) = PrepayByAmt (mulBR b x, rs) +stressPrepaymentAssump x (PrepayStressByTs ts a) = PrepayStressByTs ts (stressPrepaymentAssump x a) +stressPrepaymentAssump x (PrepaymentPSA r) = PrepaymentPSA $ min 1.0 (r*x) +stressPrepaymentAssump x (PrepaymentByTerm rss) = PrepaymentByTerm $ (capWith 1.0 <$> (map (map (* x)) rss)) data AssetPrepayAssumption = PrepaymentConstant Rate @@ -204,6 +220,8 @@ data LeaseDefaultType = DefaultByContinuation Rate data LeaseEndType = CutByDate Date | StopByExtTimes Int + | EarlierOf Date Int + | LaterOf Date Int deriving (Show,Generic,Read) data ExtraStress = ExtraStress { @@ -244,8 +262,8 @@ type AmountToBuy = Balance data TradeType = ByCash Balance - | ByBalance Balance - deriving (Show,Generic) + | ByBalance Balance + deriving (Show,Generic) data IrrType = HoldingBond HistoryCash CurrentHolding (Maybe (Date, BondPricingMethod)) | BuyBond Date BondPricingMethod TradeType (Maybe (Date, BondPricingMethod)) @@ -294,6 +312,7 @@ getRateAssumption assumps idx -- | project rates used by rate type ,with interest rate assumptions and observation dates projRates :: IRate -> RateType -> Maybe [RateAssumption] -> [Date] -> Either String [IRate] +projRates sr _ _ [] = Left "No dates provided for rate projection" projRates sr (Fix _ r) _ ds = Right $ replicate (length ds) sr projRates sr (Floater _ idx spd r dp rfloor rcap mr) Nothing ds = Left $ "Looking up rate error: No rate assumption found for index "++ show idx projRates sr (Floater _ idx spd r dp rfloor rcap mr) (Just assumps) ds @@ -321,12 +340,6 @@ projRates _ rt rassump ds = Left ("Invalid rate type: "++ show rt++" assump: "++ -- ^ Given a list of rates, calcualte whether rates was reset -calcResetDates :: [IRate] -> [Bool] -> [Bool] -calcResetDates [] bs = bs -calcResetDates (r:rs) bs - | null rs = calcResetDates [] (False:bs) - | r == head rs = calcResetDates rs (bs++[False]) - | otherwise = calcResetDates rs (bs++[True]) makePrisms ''AssetPerfAssumption makePrisms ''AssetDefaultAssumption @@ -340,7 +353,7 @@ $(deriveJSON defaultOptions ''RefiEvent) -$(concat <$> traverse (deriveJSON defaultOptions) [''LeaseDefaultType, ''LeaseEndType,''FieldMatchRule,''TagMatchRule, ''ObligorStrategy,''ApplyAssumptionType, ''AssetPerfAssumption +$(concat <$> traverse (deriveJSON defaultOptions) [''LeaseDefaultType, ''LeaseEndType,''FieldMatchRule,''TagMatchRule, ''ObligorStrategy,''ApplyAssumptionType, ''AssetPerfAssumption, ''StopBy , ''AssetDefaultedPerfAssumption, ''AssetDelinqPerfAssumption, ''NonPerfAssumption, ''AssetDefaultAssumption , ''AssetPrepayAssumption, ''RecoveryAssumption, ''ExtraStress , ''LeaseAssetGapAssump, ''LeaseAssetRentAssump, ''RevolvingAssumption, ''AssetDelinquencyAssumption,''InspectType]) diff --git a/src/Cashflow.hs b/src/Cashflow.hs index dde9309e..7a0ae04d 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -5,11 +5,11 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,combine,mergePoolCf,sumTsCF,tsSetLoss,tsSetRecovery - ,sizeCashFlowFrame,aggTsByDates + ,sizeCashFlowFrame,aggTsByDates,emptyCashFlowFrame ,mflowInterest,mflowPrincipal,mflowRecovery,mflowPrepayment ,mflowRental,mflowRate,sumPoolFlow,splitTrs,aggregateTsByDate ,mflowDefault,mflowLoss - ,getSingleTsCashFlowFrame,getDatesCashFlowFrame + ,getDatesCashFlowFrame ,lookupSource,lookupSourceM,combineTss ,mflowBegBalance,tsDefaultBal ,mflowBorrowerNum,mflowPrepaymentPenalty,tsRowBalance @@ -25,7 +25,10 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,mergeCf,buildStartTsRow ,txnCumulativeStats,consolidateCashFlow, cfBeginStatus, getBegBalCashFlowFrame ,splitCashFlowFrameByDate, mergePoolCf2, buildBegBal, extendCashFlow, patchBalance - ,getAllDatesCashFlowFrame,splitCf + ,splitPoolCashflowByDate + ,getAllDatesCashFlowFrame,splitCf, cutoffCashflow + ,AssetCashflow,PoolCashflow + ,emptyCashflow,isEmptyRow2 ) where import Data.Time (Day) @@ -34,7 +37,6 @@ import Lib (weightedBy,toDate,getIntervalFactors,daysBetween,paySeqLiabilitiesAm import Util (mulBR,mulBInt,mulIR,lastOf) import DateUtil ( splitByDate ) import Types ---import Deal.DealType import qualified Data.Map as Map import qualified Data.Time as T import qualified Data.List as L @@ -70,6 +72,17 @@ type Recoveries = [Recovery] type Rates = [Rate] type CumulativeStat = (CumPrincipal,CumPrepay,CumDelinq,CumDefault,CumRecovery,CumLoss) +type AssetCashflow = CashFlowFrame +type PoolCashflow = (AssetCashflow, Maybe [AssetCashflow]) +emptyCashflow = CashFlowFrame (0,epocDate,Nothing) [] + + +instance Monoid CashFlowFrame where + mempty = emptyCashflow + +instance Semigroup CashFlowFrame where + CashFlowFrame (begBal1, begDate1, mAccInt1) ts1 <> CashFlowFrame (begBal2, begDate2, mAccInt2) ts2 + = CashFlowFrame (begBal1,begDate1,mAccInt1) (ts1 <> ts2) opStats :: (Balance -> Balance -> Balance) -> Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat opStats op (Just (a1,b1,c1,d1,e1,f1)) (Just (a2,b2,c3,d2,e2,f2)) = Just (op a1 a2,op b1 b2,op c1 c3,op d1 d2,op e1 e2,op f1 f2) @@ -182,7 +195,6 @@ type BeginStatus = (BeginBalance, BeginDate, AccuredInterest) data CashFlowFrame = CashFlowFrame BeginStatus [TsRow] | MultiCashFlowFrame (Map.Map String [CashFlowFrame]) --- | CashFlowFrameIndex BeginStatus [TsRow] IR.Index deriving (Eq,Generic,Ord) cfBeginStatus :: Lens' CashFlowFrame BeginStatus @@ -228,6 +240,10 @@ instance NFData CashFlowFrame where sizeCashFlowFrame :: CashFlowFrame -> Int sizeCashFlowFrame (CashFlowFrame _ ts) = length ts +emptyCashFlowFrame :: CashFlowFrame -> Bool +emptyCashFlowFrame (CashFlowFrame _ []) = True +emptyCashFlowFrame (CashFlowFrame _ _) = False + getDatesCashFlowFrame :: CashFlowFrame -> [Date] getDatesCashFlowFrame (CashFlowFrame _ ts) = getDates ts @@ -246,9 +262,6 @@ cfAt (CashFlowFrame _ trs) idx cfInsertHead :: TsRow -> CashFlowFrame -> CashFlowFrame cfInsertHead tr (CashFlowFrame st trs) = CashFlowFrame st $ tr:trs -getSingleTsCashFlowFrame :: CashFlowFrame -> Date -> TsRow -getSingleTsCashFlowFrame (CashFlowFrame _ trs) d - = head $ filter (\x -> getDate x == d) trs splitCashFlowFrameByDate :: CashFlowFrame -> Date -> SplitType -> (CashFlowFrame,CashFlowFrame) splitCashFlowFrameByDate (CashFlowFrame status txns) d st @@ -256,10 +269,23 @@ splitCashFlowFrameByDate (CashFlowFrame status txns) d st (ls,rs) = splitByDate txns d st newStatus = case rs of [] -> (0, d, Nothing) - (r:_) -> (mflowBegBalance r, d, Nothing) + (r:_) -> (buildBegBal rs, d, Nothing) in (CashFlowFrame status ls,CashFlowFrame newStatus rs) + +splitPoolCashflowByDate :: PoolCashflow -> Date -> SplitType -> (PoolCashflow,PoolCashflow) +splitPoolCashflowByDate (poolCF, mAssetCfs) d st + = let + (lPoolCF,rPoolCF) = splitCashFlowFrameByDate poolCF d st + mAssetSplited = (\xs -> [ splitCashFlowFrameByDate x d st | x <- xs ]) <$> mAssetCfs + assetCfs = (\xs -> [ (lCf, rCf) | (lCf,rCf) <- xs ]) <$> mAssetSplited + lAssetCfs = (fst <$>) <$> assetCfs + rAssetCfs = (snd <$>) <$> assetCfs + in + ((lPoolCF, lAssetCfs) , (rPoolCF, rAssetCfs)) + + getTxnLatestAsOf :: CashFlowFrame -> Date -> Maybe TsRow getTxnLatestAsOf (CashFlowFrame _ txn) d = L.find (\x -> getDate x <= d) $ reverse txn @@ -399,7 +425,7 @@ addTsCF (ReceivableFlow d1 b1 af1 p1 fp1 def1 rec1 los1 st1) (ReceivableFlow d2 buildBegBal :: [TsRow] -> Balance buildBegBal [] = 0 -buildBegBal (x:_) = mflowBegBalance x +buildBegBal (x:xs) = mflowBegBalance x sumTs :: [TsRow] -> Date -> TsRow @@ -600,6 +626,7 @@ mflowRecovery (MortgageDelinqFlow _ _ _ _ _ _ _ x _ _ _ _ _) = x mflowRecovery (LoanFlow _ _ _ _ _ _ x _ _ _) = x mflowRecovery FixedFlow {} = 0 mflowRecovery (ReceivableFlow _ _ _ _ _ _ x _ _ ) = x +mflowRecovery (LeaseFlow _ _ _ _) = 0 mflowRecovery _ = error "not supported" tsRowBalance :: Lens' TsRow Balance @@ -748,6 +775,7 @@ tsSetRate _r (MortgageFlow a b c d e f g h i j k l) = MortgageFlow a b c d e f g tsSetRate _r (LoanFlow a b c d e f g i j k) = LoanFlow a b c d e f g i _r k tsSetRate _r (BondFlow a b c d) = BondFlow a b c d tsSetRate _r (ReceivableFlow a b c d e f g h i) = ReceivableFlow a b c d e f g h i +tsSetRate _r (LeaseFlow a b c d) = LeaseFlow a b c d tsSetRate _r (FixedFlow {} ) = error "Not implement set rate for FixedFlow" tsSetRate _ _ = error "Not implement set rate for this type" @@ -1075,9 +1103,23 @@ cutoffTrs d trs in (patchCumulative (0.0,0.0,0.0,0.0,0.0,0.0) [] afterTrs, m) +-- TODO need to fix accrue interest & cutoff stat +cutoffCashflow :: Date -> Dates -> CashFlowFrame -> CashFlowFrame +cutoffCashflow sd ds (CashFlowFrame st []) = CashFlowFrame st [] +cutoffCashflow sd ds (CashFlowFrame st txns) + = let + futureTxns = cutBy Inc Future sd txns + withBegTs [] = [] + withBegTs (tr:trs) = buildBegTsRow sd tr: tr :trs + aggTxns = aggTsByDates (withBegTs futureTxns) ds + in + CashFlowFrame (buildBegBal aggTxns, sd, Nothing) aggTxns + + extendTxns :: TsRow -> [Date] -> [TsRow] extendTxns tr ds = [ emptyTsRow d tr | d <- ds ] +-- test emtpy cashflow row isEmptyRow :: TsRow -> Bool isEmptyRow (MortgageDelinqFlow _ 0 0 0 0 0 0 0 0 _ _ _ _) = True isEmptyRow (MortgageFlow _ 0 0 0 0 0 0 0 _ _ _ _) = True @@ -1089,6 +1131,7 @@ isEmptyRow (CashFlow _ 0) = True isEmptyRow (ReceivableFlow _ 0 0 0 0 0 0 0 _ ) = True isEmptyRow _ = False +-- test emtpy cashflow row (ignore balance) isEmptyRow2 :: TsRow -> Bool isEmptyRow2 (MortgageDelinqFlow _ _ 0 0 0 0 0 0 0 _ _ _ _) = True isEmptyRow2 (MortgageFlow _ _ 0 0 0 0 0 0 _ _ _ _) = True @@ -1105,6 +1148,7 @@ dropTailEmptyTxns :: [TsRow] -> [TsRow] dropTailEmptyTxns trs = reverse $ dropWhile isEmptyRow (reverse trs) + cashflowTxn :: Lens' CashFlowFrame [TsRow] cashflowTxn = lens getter setter where @@ -1131,8 +1175,5 @@ txnCumulativeStats = lens getter setter = ReceivableFlow d bal p i ppy def recovery loss mStat setter x _ = x - - - $(deriveJSON defaultOptions ''TsRow) $(deriveJSON defaultOptions ''CashFlowFrame) diff --git a/src/Deal.hs b/src/Deal.hs index e33dc5be..10e19e52 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleContexts #-} module Deal (run,runPool,getInits,runDeal,ExpectReturn(..) ,performAction @@ -61,7 +62,7 @@ import Data.Time.Clock import Data.Maybe import Data.Either import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty +-- import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types @@ -125,7 +126,6 @@ setBondNewRate t d ras b@(L.MultiIntBond bn _ _ iis _ bal currentRates _ dueInts in Right $ b' { L.bndRates = newRates } -setBondNewRate t d ras b = Left $ "set bond new rate: "++ show d ++"Failed to set bond rate: "++show b++"from rate assumption" ++ show ras setBondStepUpRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond @@ -166,7 +166,6 @@ accrueSrt t d srt@HE.SRT{ HE.srtDuePremium = duePrem, HE.srtRefBalance = bal, HE = do newBal <- case st of HE.SrtByEndDay ds dp -> queryCompound t d (patchDateToStats d ds) - _ -> Left "not support new bal type for Srt" let newPremium = duePrem + calcInt (fromRational newBal) (fromMaybe sd mDueDate) d rate DC_ACT_365F let accrueInt = calcInt (HE.srtRefBalance srt + duePrem) (fromMaybe d (HE.srtDuePremiumDate srt)) d (HE.srtPremiumRate srt) DC_ACT_365F return srt { HE.srtRefBalance = fromRational newBal, HE.srtDuePremium = newPremium, HE.srtDuePremiumDate = Just d} @@ -182,7 +181,6 @@ updateLiqProviderRate t d ras liq@CE.LiqFacility{CE.liqRateType = mRt, CE.liqPre in liq {CE.liqRate = newMr, CE.liqPremiumRate = newMpr } -updateLiqProviderRate t d ras liq = liq evalFloaterRate :: Date -> [RateAssumption] -> IR.RateType -> IRate evalFloaterRate _ _ (IR.Fix _ r) = r @@ -302,8 +300,8 @@ accrueRC t d rs rc@RateCap{rcNetCash = amt, rcStrikeRate = strike,rcIndex = inde testCall :: Ast.Asset a => TestDeal a -> Date -> C.CallOption -> Either String Bool testCall t d opt = case opt of - C.PoolBalance x -> (< x) <$> fromRational <$> queryCompound t d (FutureCurrentPoolBalance Nothing) - C.BondBalance x -> (< x) <$> fromRational <$> queryCompound t d CurrentBondBalance + C.PoolBalance x -> (< x) . fromRational <$> queryCompound t d (FutureCurrentPoolBalance Nothing) + C.BondBalance x -> (< x) . fromRational <$> queryCompound t d CurrentBondBalance C.PoolFactor x -> (< x) <$> queryCompound t d (FutureCurrentPoolFactor d Nothing) -- `debug` ("D "++show d++ "Pool Factor query ->" ++ show (queryDealRate t (FutureCurrentPoolFactor d))) C.BondFactor x -> (< x) <$> queryCompound t d BondFactor C.OnDate x -> Right $ x == d @@ -344,6 +342,23 @@ runEffects (t@TestDeal{accounts = accMap, fees = feeMap ,status=st, bonds = bond (newT, newRc, newLogs) <- foldM (performActionWrap d) (t, rc, DL.empty) wActions return (newT, newRc, actions, DL.append logs newLogs) + ChangeBondRate bName bRateType bRate -> + let + -- accrual rate + -- set current rate + -- update rate component + updateFn b = L.accrueInt d b + & set L.interestInfoTraversal bRateType + & set L.curRatesTraversal bRate + -- updated deal + t' = t {bonds = updateBondInMap bName updateFn bondMap} + -- build bond rate reset actions + newActions = case getBondByName t' True bName of + Just bnd -> [ ResetBondRate _d bName | _d <- L.buildRateResetDates bnd d (getDate (last actions))] + Nothing -> [] + in + Right (t' , rc, sortBy sortActionOnDate (newActions++actions), logs) + DoNothing -> Right (t, rc, actions, DL.empty) _ -> Left $ "Date:"++ show d++" Failed to match trigger effects: "++show te @@ -370,46 +385,55 @@ runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc, actions) d d changeDealStatus:: Ast.Asset a => (Date,String)-> DealStatus -> TestDeal a -> (Maybe ResultComponent, TestDeal a) -- ^ no status change for deal already ended -changeDealStatus _ _ t@TestDeal{status=Ended} = (Nothing, t) +changeDealStatus _ _ t@TestDeal{status=Ended _} = (Nothing, t) changeDealStatus (d,why) newSt t@TestDeal{status=oldSt} = (Just (DealStatusChangeTo d oldSt newSt why), t {status=newSt}) -run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.CashFlowFrame -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre]) - -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType))-> DL.DList ResultComponent -> Either String (TestDeal a,DL.DList ResultComponent) -run t@TestDeal{status=Ended} pCfM ads _ _ _ log = Right (prepareDeal t,(DL.snoc log (EndRun Nothing "By Status:Ended"))) -run t pCfM (Just []) _ _ _ log = Right (prepareDeal t,(DL.snoc log (EndRun Nothing "No Actions"))) -run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = Right (prepareDeal t, (DL.snoc log (EndRun (Just d) "Stop: Stated Maturity"))) -run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = Right (prepareDeal t, (DL.snoc log (EndRun (Just d) "Stop Run Flag"))) +run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.PoolCashflow -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre]) + -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType)) -> DL.DList ResultComponent + -> Either String (TestDeal a,DL.DList ResultComponent, Map.Map PoolId CF.PoolCashflow) +run t@TestDeal{status=(Ended endedDate)} pCfM ads _ _ _ log = return (t,DL.snoc log (EndRun (Just endedDate) "By Status:Ended"), pCfM) +run t pCfM (Just []) _ _ _ log = return (t,DL.snoc log (EndRun Nothing "No Actions"), pCfM) +run t pCfM (Just [HitStatedMaturity d]) _ _ _ log = return (t, DL.snoc log (EndRun (Just d) "Stop: Stated Maturity"), pCfM) +run t pCfM (Just (StopRunFlag d:_)) _ _ _ log = return (t, DL.snoc log (EndRun (Just d) "Stop Run Flag"), pCfM) run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=dStatus - ,waterfall=waterfallM,name=dealName,pool=pt,stats=_stat} + ,waterfall=waterfallM,name=dealName,pool=pt,stats=_stat} poolFlowMap (Just (ad:ads)) rates calls rAssump log - | all (== 0) futureCashToCollect && (queryCompound t (getDate ad) AllAccBalance == Right 0) && (dStatus /= Revolving) && (dStatus /= Warehousing Nothing) --TODO need to use prsim here to cover all warehouse status + | futureCashToCollectFlag && (queryCompound t (getDate ad) AllAccBalance == Right 0) && (dStatus /= Revolving) && (dStatus /= Warehousing Nothing) --TODO need to use prsim here to cover all warehouse status = do - let runContext = RunContext poolFlowMap rAssump rates + let runContext = RunContext poolFlowMap rAssump rates --- `debug` ("ending at date " ++ show (getDate ad)) (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions - return (prepareDeal finalDeal, (DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving"))) -- `debug` ("End of pool collection with logs with length "++ show (length log)) + return (finalDeal + , DL.snoc newLogs (EndRun (Just (getDate ad)) "No Pool Cashflow/All Account is zero/Not revolving") + , poolFlowMap) | otherwise = case ad of PoolCollection d _ -> if any (> 0) remainCollectionNum then let - cutOffPoolFlowMap = Map.map (\pflow -> CF.splitCashFlowFrameByDate pflow d EqToLeft) poolFlowMap - collectedFlow = Map.map fst cutOffPoolFlowMap -- `debug` ("PoolCollection : "++ show d ++ " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap) + cutOffPoolFlowMap = Map.map (\(pflow,mAssetFlow) -> + (CF.splitCashFlowFrameByDate pflow d EqToLeft + ,(\xs -> [ CF.splitCashFlowFrameByDate x d EqToLeft | x <- xs ]) <$> mAssetFlow)) + poolFlowMap + collectedFlow = Map.map (\(p,mAstFlow) -> (fst p, (\xs -> [ fst x | x <- xs ]) <$> mAstFlow)) cutOffPoolFlowMap -- `debug` ("PoolCollection : "++ show d ++ " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap) -- outstandingFlow = Map.map (CF.insertBegTsRow d . snd) cutOffPoolFlowMap - outstandingFlow = Map.map snd cutOffPoolFlowMap + outstandingFlow = Map.map (\(p,mAstFlow) -> (snd p, (\xs -> [ snd x | x <- xs ]) <$> mAstFlow)) cutOffPoolFlowMap -- deposit cashflow to SPV from external pool cf in do accs <- depositPoolFlow (collects t) d collectedFlow accMap -- `debug` ("PoolCollection: deposit >>"++ show d++">>>"++ show collectedFlow++"\n") - let dAfterDeposit = (appendCollectedCF d t collectedFlow) {accounts=accs} -- `debug` ("Collected flow"++ show collectedFlow) + let dAfterDeposit = (appendCollectedCF d t collectedFlow) {accounts=accs} -- newScheduleFlowMap = Map.map (over CF.cashflowTxn (cutBy Exc Future d)) (fromMaybe Map.empty (getScheduledCashflow t Nothing)) - let dealAfterUpdateScheduleFlow = over dealScheduledCashflow - (Map.map (\mflow -> over CF.cashflowTxn (cutBy Exc Future d) <$> mflow)) - dAfterDeposit + let newPt = case (pool dAfterDeposit) of + MultiPool pm -> MultiPool $ + Map.map + (over (P.poolFutureScheduleCf . _Just . _1 . CF.cashflowTxn) (cutBy Exc Future d)) + pm + ResecDeal dMap -> ResecDeal dMap let runContext = RunContext outstandingFlow rAssump rates -- `debug` ("PoolCollection: before rc >>"++ show d++">>>"++ show (pool dAfterDeposit)) - (dRunWithTrigger0, rc1, ads2, newLogs0) <- runTriggers (dealAfterUpdateScheduleFlow,runContext,ads) d EndCollection -- `debug` ("PoolCollection: after update schedule flow >>"++ show d++">>"++show (pool dealAfterUpdateScheduleFlow)) + (dRunWithTrigger0, rc1, ads2, newLogs0) <- runTriggers (dAfterDeposit {pool = newPt},runContext,ads) d EndCollection let eopActionsLog = DL.fromList [ RunningWaterfall d W.EndOfPoolCollection | Map.member W.EndOfPoolCollection waterfallM ] -- `debug` ("new logs from trigger 1"++ show newLogs0) let waterfallToExe = Map.findWithDefault [] W.EndOfPoolCollection (waterfall t) -- `debug` ("new logs from trigger 1"++ show newLogs0) (dAfterAction,rc2,newLogs) <- foldM (performActionWrap d) (dRunWithTrigger0 ,rc1 ,log ) waterfallToExe -- `debug` ("Pt 03"++ show d++">> context flow"++show (pool dRunWithTrigger0))-- `debug` ("End collection action"++ show waterfallToExe) @@ -420,9 +444,9 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= rates calls rAssump - (DL.concat [newLogs0,newLogs,eopActionsLog,newLogs1]) -- `debug` ("PoolCollection: Pt 05>> "++ show d++">> context flow>> "++show (runPoolFlow rc3)) + (DL.concat [newLogs0,newLogs,eopActionsLog,newLogs1]) else - run t poolFlowMap (Just ads) rates calls rAssump log -- `debug` ("PoolCollection: hit zero pool length"++ show d++"pool"++ (show poolFlowMap)++"collected cf"++ show pt) + run t poolFlowMap (Just ads) rates calls rAssump log RunWaterfall d "" -> let @@ -436,7 +460,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= callTest = fst $ fromMaybe ([]::[Pre],[]::[Pre]) calls in do - (dRunWithTrigger0, rc1, ads1, newLogs0) <- runTriggers (t, runContext, ads) d BeginDistributionWF -- `debug` ("In RunWaterfall Date"++show d++"before run trigger>> collected"++ show (pool t)) + (dRunWithTrigger0, rc1, ads1, newLogs0) <- runTriggers (t, runContext, ads) d BeginDistributionWF let logsBeforeDist = DL.concat [newLogs0 , DL.fromList [ WarningMsg (" No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) | Map.notMember waterfallKey waterfallM ] ] flag <- anyM (testPre d dRunWithTrigger0) callTest -- `debug` ( "In RunWaterfall status after before waterfall trigger >>"++ show (status dRunWithTrigger0) ) @@ -448,7 +472,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= [DealStatusChangeTo d dStatus Called "Call by triggers before waterfall distribution", RunningWaterfall d W.CleanUp] (dealAfterCleanUp, rc_, newLogWaterfall_ ) <- foldM (performActionWrap d) (dRunWithTrigger0, rc1,log) cleanUpActions endingLogs <- Rpt.patchFinancialReports dealAfterCleanUp d newLogWaterfall_ - return (prepareDeal dealAfterCleanUp, DL.concat [logsBeforeDist,DL.fromList (newStLogs++[EndRun (Just d) "Clean Up"]),endingLogs]) -- `debug` ("Called ! "++ show d) + return (dealAfterCleanUp, DL.concat [logsBeforeDist,DL.fromList (newStLogs++[EndRun (Just d) "Clean Up"]),endingLogs], poolFlowMap) -- `debug` ("Called ! "++ show d) else do (dAfterWaterfall, rc2, newLogsWaterfall) <- foldM (performActionWrap d) (dRunWithTrigger0,rc1,log) waterfallToExe -- `debug` ("In RunWaterfall Date"++show d++">>> status "++show (status dRunWithTrigger0)++"before run waterfall collected >>"++ show (pool dRunWithTrigger0)) @@ -489,7 +513,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= ("Failed to find fee "++feeName) (Map.lookup feeName feeMap) newF <- calcDueFee t d fToAcc - let newFeeMap = (Map.fromList [(feeName,newF)]) <> feeMap + let newFeeMap = Map.fromList [(feeName,newF)] <> feeMap run (t{fees=newFeeMap}) poolFlowMap (Just ads) rates calls rAssump log ResetLiqProvider d liqName -> @@ -533,7 +557,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= do newRateSwap_rate <- adjustM (updateRateSwapRate t rates d) sn rSwap newRateSwap_bal <- adjustM (updateRateSwapBal t d) sn newRateSwap_rate - let newRateSwap_acc = Map.adjust (HE.accrueIRS d) sn $ newRateSwap_bal + let newRateSwap_acc = Map.adjust (HE.accrueIRS d) sn newRateSwap_bal run (t{rateSwap = Just newRateSwap_acc}) poolFlowMap (Just ads) rates calls rAssump log SettleIRSwap d sn -> @@ -648,15 +672,17 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= MakeWhole d spd walTbl -> let - schedulePoolFlowMap = Map.map (fromMaybe (CF.CashFlowFrame (0,epocDate,Nothing) [])) $ view dealScheduledCashflow t + schedulePoolFlowMap = case pt of + MultiPool pMap -> Map.map (view (P.poolFutureScheduleCf._Just._1) ) pMap + ResecDeal uDealMap -> Map.map (view uDealFutureScheduleCf) uDealMap in do factor <- liftA2 (/) (queryCompound t d (FutureCurrentPoolBegBalance Nothing)) (queryCompound t d (FutureCurrentSchedulePoolBegBalance Nothing)) - let reduceCfs = Map.map (over CF.cashflowTxn (\xs -> (CF.scaleTsRow factor) <$> xs)) schedulePoolFlowMap -- need to apply with factor and trucate with date - (runDealWithSchedule,_) <- run t reduceCfs (Just ads) rates calls rAssump $ log + let reduceCfs = Map.map (\f -> (over CF.cashflowTxn (\xs -> CF.scaleTsRow factor <$> xs) f, Nothing ) ) schedulePoolFlowMap -- need to apply with factor and trucate with date + (runDealWithSchedule,_,_) <- run t reduceCfs (Just ads) rates calls rAssump log let bondWal = Map.map (L.calcWalBond d) (bonds runDealWithSchedule) -- `debug` ("Bond schedule flow"++ show (bonds runDealWithSchedule)) let bondSprd = Map.map (\x -> (spd + (fromMaybe 0 (lookupTable walTbl Up (fromRational x >))))) @@ -676,7 +702,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= L.payYield d intToPay bnd1) (bonds t) bondPricingResult - run t {bonds = depositBondFlow, status = Ended } poolFlowMap (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call") + run t {bonds = depositBondFlow, status = Ended d} Map.empty (Just []) rates calls rAssump $ DL.snoc log (EndRun (Just d) "MakeWhole call") FundBond d Nothing bName accName fundAmt -> let @@ -761,8 +787,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= -- TODO tobe fix let bResetActions = [] let newAccMap = Map.insert accName newAcc accMap - let newBndMap = Map.insert bName (newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d - ,L.bndLastIntPay = Just d}) bndMap + let newBndMap = Map.insert bName (newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d ,L.bndLastIntPay = Just d}) bndMap let newAds = sortBy sortActionOnDate $ filteredAds ++ bResetActions run t{bonds = newBndMap, accounts = newAccMap} poolFlowMap (Just newAds) rates calls rAssump log @@ -786,32 +811,38 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= do (dealAfterCleanUp, rc_, newLogWaterfall_ ) <- foldM (performActionWrap d) (t, runContext, log) cleanUpActions endingLogs <- Rpt.patchFinancialReports dealAfterCleanUp d newLogWaterfall_ - return (prepareDeal dealAfterCleanUp, DL.snoc (endingLogs `DL.append` newStLogs) (EndRun (Just d) "Clean Up")) -- `debug` ("Called ! "++ show d) + return (dealAfterCleanUp, DL.snoc (endingLogs `DL.append` newStLogs) (EndRun (Just d) "Clean Up"), poolFlowMap) -- `debug` ("Called ! "++ show d) _ -> run t poolFlowMap (Just ads) rates calls rAssump log + StopRunTest d pres -> + do + flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- pres ] + case all id flags of + True -> return (t, DL.snoc log (EndRun (Just d) ("Stop Run Test by:"++ show (zip pres flags))), poolFlowMap) + _ -> run t poolFlowMap (Just ads) rates calls rAssump log + + _ -> Left $ "Failed to match action on Date"++ show ad where cleanUpActions = Map.findWithDefault [] W.CleanUp (waterfall t) -- `debug` ("Running AD"++show(ad)) - remainCollectionNum = Map.elems $ Map.map CF.sizeCashFlowFrame poolFlowMap - futureCashToCollect = Map.elems $ Map.map (\pcf -> sum (CF.tsTotalCash <$> view CF.cashflowTxn pcf)) poolFlowMap + remainCollectionNum = Map.elems $ Map.map (\(x,_) -> CF.sizeCashFlowFrame x ) poolFlowMap + futureCashToCollectFlag = and $ Map.elems $ Map.map (\(pcf,_) -> all CF.isEmptyRow2 (view CF.cashflowTxn pcf)) poolFlowMap run t empty Nothing Nothing Nothing Nothing log = do - (t, ads, pcf, unStressPcf) <- getInits t Nothing Nothing + (t, ads, pcf, unStressPcf) <- getInits S.empty t Nothing Nothing run t pcf (Just ads) Nothing Nothing Nothing log -- `debug` ("Init Done >>Last Action#"++show (length ads)++"F/L"++show (head ads)++show (last ads)) -run t empty _ _ _ _ log = Right (prepareDeal t, log) -- `debug` ("End with pool CF is []") +run t empty _ _ _ _ log = Right (t, log ,empty) -- `debug` ("End with pool CF is []") -- reserved for future used -data ExpectReturn = DealPoolFlow - | DealPoolFlowPricing -- ^ default option, return pricing and bond/pool/account/fee etc cashflow - | DealTxns - | ExecutionSummary - deriving (Show,Generic) +data ExpectReturn = DealLogs + | AssetLevelFlow + deriving (Show,Generic,Ord,Eq) -- priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [(Date,Balance)]) @@ -897,7 +928,7 @@ priceBondIrr (AP.BuyBond dateToBuy bPricingMethod (AP.ByCash cash) Nothing) txns (ds2, vs2) = (getDate <$> futureFlow', getTxnAmt <$> boughtTxns) in do - irr <- Analytics.calcIRR ([ds1]++ds2) ([vs1]++vs2) + irr <- Analytics.calcIRR (ds1:ds2) (vs1:vs2) return (irr, (BondTxn dateToBuy 0 (negate accuredInt) (negate buyPaidOut) 0 vs1 0 0 Nothing Types.Empty):boughtTxns) where -- assume cashflow of buy date belongs to seller(owner) @@ -911,7 +942,7 @@ priceBonds t (AP.DiscountCurve d dc) = Right $ Map.map (L.priceBond d dc) (viewB priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bondPrices) = sequenceA $ Map.mapWithKey - (\bn (pd,price)-> ZSpread <$> (L.calcZspread (price,pd) (bndMap Map.! bn) curve)) + (\bn (pd,price)-> ZSpread <$> L.calcZspread (price,pd) (bndMap Map.! bn) curve) bondPrices -- Calc Irr of bonds priceBonds t@TestDeal {bonds = bndMap} (AP.IrrInput bMapInput) @@ -953,7 +984,6 @@ splitCallOpts (AP.LegacyOpts copts) = ([ cFn copt | copt <- copts ],[]) -- legacyCallOptConvert (AP.CallOptions opts) = concat [ legacyCallOptConvert o | o <- opts ] splitCallOpts (AP.CallOnDates dp ps) = ([],ps) -splitCallOpts x = error $ "Failed to find call option types but got"++ show x -- , @@ -966,26 +996,41 @@ readCallOptions opts = (concat (fst <$> result), concat (snd <$> result)) -runDeal :: Ast.Asset a => TestDeal a -> ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption - -> Either String (TestDeal a, Maybe (Map.Map PoolId CF.CashFlowFrame), Maybe [ResultComponent], Map.Map String PriceResult) -runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts ,AP.pricing = mPricing ,AP.revolving = mRevolving ,AP.interest = mInterest} +runDeal :: Ast.Asset a => TestDeal a -> S.Set ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption + -> Either String (TestDeal a + , Map.Map PoolId CF.CashFlowFrame + , [ResultComponent] + , Map.Map String PriceResult + , Map.Map PoolId CF.PoolCashflow) +runDeal t er perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts ,AP.pricing = mPricing ,AP.revolving = mRevolving ,AP.interest = mInterest} | not runFlag = Left $ intercalate ";" $ show <$> valLogs | otherwise = do - (newT, ads, pcf, unStressPcf) <- getInits t perfAssumps (Just nonPerfAssumps) - (finalDeal, logs) <- run (removePoolCf newT) - pcf - (Just ads) - mInterest - (readCallOptions <$> opts) - mRevolvingCtx - DL.empty - let poolFlowUsed = Map.map (fromMaybe (CF.CashFlowFrame (0,toDate "19000101",Nothing) [])) (getAllCollectedFrame finalDeal Nothing) - let poolFlowUsedNoEmpty = Map.map (over CF.cashflowTxn CF.dropTailEmptyTxns) poolFlowUsed + (newT, ads, pcf, unStressPcf) <- getInits er t perfAssumps (Just nonPerfAssumps) + (_finalDeal, logs, osPoolFlow) <- run (removePoolCf newT) + pcf + (Just ads) + mInterest + (readCallOptions <$> opts) + mRevolvingCtx + DL.empty + -- prepare deal with expected return + let finalDeal = prepareDeal er _finalDeal + -- extract pool cash collected to deal + let poolFlowUsedNoEmpty = Map.map + (over CF.cashflowTxn CF.dropTailEmptyTxns) + (getAllCollectedFrame finalDeal Nothing) + let poolFlowUnUsed = osPoolFlow & mapped . _1 . CF.cashflowTxn %~ CF.dropTailEmptyTxns + & mapped . _2 . _Just . each . CF.cashflowTxn %~ CF.dropTailEmptyTxns bndPricing <- case mPricing of (Just p) -> priceBonds finalDeal p Nothing -> Right Map.empty - return (finalDeal, Just poolFlowUsedNoEmpty, Just (getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList logs), bndPricing) -- `debug` ("Run Deal end with") + return (finalDeal + , poolFlowUsedNoEmpty + , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList (DL.append logs (unCollectedPoolFlowWarning poolFlowUnUsed)) + , bndPricing + , poolFlowUnUsed + ) -- `debug` ("run deal done with pool" ++ show poolFlowUsedNoEmpty) where (runFlag, valLogs) = V.validateReq t nonPerfAssumps -- getinits() will get (new deal snapshot, actions, pool cashflows, unstressed pool cashflow) @@ -994,7 +1039,14 @@ runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts , Nothing -> Nothing Just (AP.AvailableAssets rp rperf) -> Just (Map.fromList [("Consol", (rp, rperf))]) Just (AP.AvailableAssetsBy rMap) -> Just rMap - Just _ -> error ("Failed to match revolving assumption"++show mRevolving) + unCollectedPoolFlowWarning pMap = let + countMap = Map.map (CF.sizeCashFlowFrame . view _1) pMap + in + if sum (Map.elems countMap) > 0 then + DL.singleton $ WarningMsg $ "Oustanding pool cashflow hasn't been collected yet"++ show countMap + else + DL.empty + -- run() is a recusive function loop over all actions till deal end conditions are met -- | get bond principal and interest shortfalls from a deal @@ -1005,72 +1057,100 @@ getRunResult t = os_bn_i ++ os_bn_b -- `debug` ("Done with get result") os_bn_b = [ BondOutstanding (L.bndName _b) (L.getCurBalance _b) (getBondBegBal t (L.bndName _b)) | _b <- bs ] -- `debug` ("B"++ show bs) os_bn_i = [ BondOutstandingInt (L.bndName _b) (L.getTotalDueInt _b) (getBondBegBal t (L.bndName _b)) | _b <- bs ] -- `debug` ("C"++ show bs) -prepareDeal :: Ast.Asset a => TestDeal a -> TestDeal a -prepareDeal t@TestDeal {bonds = bndMap, liqProvider = mLiqProvider} + +-- | consolidate pool cashflow +-- consolidate bond cashflow and patch factor +prepareDeal :: Ast.Asset a => S.Set ExpectReturn -> TestDeal a -> TestDeal a +prepareDeal er t@TestDeal {bonds = bndMap ,pool = poolType } = let - pIdCf = view dealCashflow t - newPtMap = Map.map (\mCf -> (over CF.cashflowTxn CF.dropTailEmptyTxns) <$> mCf ) - pIdCf - t1 = set dealCashflow newPtMap t + consolePoolFlowFn = over CF.cashflowTxn CF.dropTailEmptyTxns + rmAssetLevelFn xs + | S.member AssetLevelFlow er = xs + | otherwise = [] in - t1 {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap } + t {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap + ,pool = poolType & over (_MultiPool . mapped . P.poolFutureCf . _Just ._1) consolePoolFlowFn + & over (_ResecDeal . mapped . uDealFutureCf) consolePoolFlowFn + & over (_MultiPool . mapped . P.poolFutureCf . _Just . _2 . _Just) rmAssetLevelFn + } -appendCollectedCF :: Ast.Asset a => Date -> TestDeal a -> Map.Map PoolId CF.CashFlowFrame -> TestDeal a +appendCollectedCF :: Ast.Asset a => Date -> TestDeal a -> Map.Map PoolId CF.PoolCashflow -> TestDeal a -- ^ append cashflow frame (consolidate by a date) into deals collected pool appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap - = let + = let newPt = case pt of MultiPool poolM -> MultiPool $ Map.foldrWithKey - (\k (CF.CashFlowFrame _ txnCollected) acc -> + (\k (CF.CashFlowFrame st txnCollected, mAssetFlow) acc -> let - currentStats = case view P.poolFutureTxn (acc Map.! k) of + currentStats = case view (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (acc Map.! k) of [] -> P.poolBegStats (acc Map.! k) txns -> fromMaybe (0,0,0,0,0,0) $ view CF.txnCumulativeStats (last txns) balInCollected = case length txnCollected of 0 -> 0 _ -> view CF.tsRowBalance $ last txnCollected txnToAppend = CF.patchCumulative currentStats [] txnCollected - accUpdated = Map.adjust (over P.poolFutureTxn (++ txnToAppend)) k acc + -- insert aggregated pool flow + accUpdated = Map.adjust + (\_v -> case (P.futureCf _v) of + Nothing -> set P.poolFutureCf (Just (CF.CashFlowFrame st txnCollected , Nothing)) _v + Just _ -> over (P.poolFutureCf . _Just . _1 . CF.cashflowTxn) (++ txnToAppend) _v + ) + k + acc + -- insert breakdown asset flow + accUpdated' = case mAssetFlow of + Nothing -> accUpdated + Just collectedAssetFlow -> + let + appendFn Nothing = Just collectedAssetFlow + appendFn (Just cfs) + | length cfs == length collectedAssetFlow + = Just $ [ origin & over CF.cashflowTxn (++ (view CF.cashflowTxn new)) | (origin,new) <- zip cfs collectedAssetFlow ] + | length collectedAssetFlow > length cfs + = let + dummyCashFrames = replicate (length collectedAssetFlow - length cfs) CF.emptyCashflow + in + Just $ [ origin & over (CF.cashflowTxn) (++ (view CF.cashflowTxn new)) | (origin,new) <- zip (cfs++dummyCashFrames) collectedAssetFlow ] + | otherwise = error "incomping cashflow number shall greater than existing cashflow number" + in + accUpdated & ix k %~ (over (P.poolFutureCf . _Just . _2) appendFn) in Map.adjust (over P.poolIssuanceStat (Map.insert RuntimeCurrentPoolBalance balInCollected)) - k accUpdated) - poolM + k accUpdated') + poolM poolInflowMap ResecDeal uds -> ResecDeal $ Map.foldrWithKey - (\k (CF.CashFlowFrame _ newTxns) acc-> + (\k (CF.CashFlowFrame _ newTxns, _) acc-> Map.adjust (over uDealFutureTxn (++ newTxns)) k acc) - uds poolInflowMap + uds + poolInflowMap in - t {pool = newPt} -- `debug` ("after insert bal"++ show newPt) + t {pool = newPt} -- `debug` ("after insert bal"++ show newPt) -- ^ emtpy deal's pool cashflow removePoolCf :: Ast.Asset a => TestDeal a -> TestDeal a removePoolCf t@TestDeal{pool=pt} = let newPt = case pt of - MultiPool pM -> MultiPool $ Map.map (set P.poolFutureCf Nothing) pM + MultiPool pm -> MultiPool $ set (mapped . P.poolFutureCf) Nothing pm ResecDeal uds -> ResecDeal uds - _ -> error "not implement" in t {pool = newPt} - - - -- | run a pool of assets ,use asOfDate of Pool to cutoff cashflow yields from assets with assumptions supplied runPool :: Ast.Asset a => P.Pool a -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)] -- schedule cashflow just ignores the interest rate assumption -runPool (P.Pool [] (Just cf) _ asof _ _ ) Nothing _ = Right [(cf, Map.empty)] +runPool (P.Pool [] (Just (cf,_)) _ asof _ _ ) Nothing _ = Right [(cf, Map.empty)] -- schedule cashflow with stress assumption -runPool (P.Pool [] (Just (CF.CashFlowFrame _ txn)) _ asof _ (Just dp)) (Just (AP.PoolLevel assumps)) mRates +runPool (P.Pool [] (Just (CF.CashFlowFrame _ txn,_)) _ asof _ (Just dp)) (Just (AP.PoolLevel assumps)) mRates = sequenceA [ Ast.projCashflow (ACM.ScheduleMortgageFlow asof txn dp) asof assumps mRates ] -- `debug` ("PROJ in schedule flow") -- project contractual cashflow if nothing found in pool perf assumption @@ -1083,19 +1163,19 @@ runPool (P.Pool as _ _ asof _ _) Nothing mRates return [ (x, Map.empty) | x <- cf ] -- asset cashflow with credit stress ---- By pool level -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates +runPool (P.Pool as _ Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates = sequenceA $ parMap rdeepseq (\x -> Ast.projCashflow x asof assumps mRates) as ---- By index -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = +runPool (P.Pool as _ Nothing asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = let numAssets = length as in do - _assumps <- sequenceA $ map (AP.lookupAssumptionByIdx idxAssumps) [0..(pred numAssets)] -- `debug` ("Num assets"++ show numAssets) + _assumps <- traverse (AP.lookupAssumptionByIdx idxAssumps) [0..(pred numAssets)] -- `debug` ("Num assets"++ show numAssets) sequenceA $ parMap rdeepseq (\(x, a) -> Ast.projCashflow x asof a mRates) (zip as _assumps) ---- By Obligor -runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = +runPool (P.Pool as _ Nothing asof _ _) (Just (AP.ByObligor obligorRules)) mRates = let -- result cf,rules,assets -- matchAssets:: Ast.Asset c => [Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> [AP.ObligorStrategy] @@ -1171,31 +1251,32 @@ runPool (P.Pool as Nothing Nothing asof _ _) (Just (AP.ByObligor obligorRules)) (cfs ++ (parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) astList)) [] [] - - in matchAssets [] obligorRules as -- safe net to catch other cases -runPool _a _b _c = Left $ "Failed to match" ++ show _a ++ show _b ++ show _c +runPool _a _b _c = Left $ "[Run Pool]: Failed to match" ++ show _a ++ show _b ++ show _c -- ^ patch issuance balance for PreClosing Deal patchIssuanceBalance :: Ast.Asset a => DealStatus -> Map.Map PoolId Balance -> PoolType a -> PoolType a -patchIssuanceBalance (Warehousing _) balM pt = patchIssuanceBalance (PreClosing Amortizing) balM pt +-- patchIssuanceBalance (Warehousing _) balM pt = patchIssuanceBalance (PreClosing Amortizing) balM pt patchIssuanceBalance (PreClosing _ ) balM pt = case pt of - MultiPool pM -> MultiPool $ Map.mapWithKey (\k v -> over P.poolIssuanceStat (Map.insert IssuanceBalance (Map.findWithDefault 0.0 k balM)) v) pM + MultiPool pM -> MultiPool $ Map.mapWithKey + (\k v -> over P.poolIssuanceStat (Map.insert IssuanceBalance (Map.findWithDefault 0.0 k balM)) v) + pM ResecDeal pM -> ResecDeal pM --TODO patch balance for resec deal patchIssuanceBalance _ bal p = p -- `debug` ("NO patching ?") -patchScheduleFlow :: Ast.Asset a => Map.Map PoolId CF.CashFlowFrame -> PoolType a -> PoolType a + +patchScheduleFlow :: Ast.Asset a => Map.Map PoolId CF.PoolCashflow -> PoolType a -> PoolType a patchScheduleFlow flowM pt = case pt of - MultiPool pM -> MultiPool $ Map.intersectionWith (set P.poolFutureScheduleCf) (Just <$> flowM) pM + MultiPool pM -> MultiPool $ Map.intersectionWith (set (P.poolFutureScheduleCf . _Just)) flowM pM ResecDeal pM -> ResecDeal pM patchRuntimeBal :: Ast.Asset a => Map.Map PoolId Balance -> PoolType a -> PoolType a @@ -1209,51 +1290,45 @@ patchRuntimeBal balMap (MultiPool pM) patchRuntimeBal balMap pt = pt -runPoolType :: Ast.Asset a => PoolType a -> Maybe AP.ApplyAssumptionType - -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId (CF.CashFlowFrame, Map.Map CutoffFields Balance)) - -runPoolType (MultiPool pm) (Just (AP.ByName assumpMap)) mNonPerfAssump - = sequenceA $ Map.mapWithKey - (\k p -> (P.aggPool (P.issuanceStat p)) <$> - (runPool p (AP.PoolLevel <$> Map.lookup k assumpMap) (AP.interest =<< mNonPerfAssump))) - pm -runPoolType (MultiPool pm) (Just (AP.ByPoolId assumpMap)) mNonPerfAssump - = sequenceA $ Map.mapWithKey - (\k p -> (P.aggPool (P.issuanceStat p)) <$> - (runPool p (Map.lookup k assumpMap) (AP.interest =<< mNonPerfAssump))) - pm +runPoolType :: Ast.Asset a => Bool -> PoolType a -> Maybe AP.ApplyAssumptionType + -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId CF.PoolCashflow) -runPoolType (MultiPool pm) mAssumps mNonPerfAssump +runPoolType flag (MultiPool pm) (Just poolAssumpType) mNonPerfAssump + = let + rateAssump = AP.interest =<< mNonPerfAssump + calcPoolCashflow (AP.ByName assumpMap) pid v = runPool v (AP.PoolLevel <$> Map.lookup pid assumpMap) rateAssump + calcPoolCashflow (AP.ByPoolId assumpMap) pid v = runPool v (Map.lookup pid assumpMap) rateAssump + calcPoolCashflow poolAssump pid v = runPool v (Just poolAssump) rateAssump + in + sequenceA $ + Map.mapWithKey + (\k v -> + let + poolBegStats = P.issuanceStat v + in + do + assetCfs <- calcPoolCashflow poolAssumpType k v + let (poolCf,_) = P.aggPool poolBegStats assetCfs + return (poolCf, if flag then + Just $ fst <$> assetCfs + else + Nothing)) + pm + +runPoolType flag (MultiPool pm) mAssumps mNonPerfAssump = sequenceA $ - Map.map (\p -> (P.aggPool (P.issuanceStat p)) <$> (runPool p mAssumps (AP.interest =<< mNonPerfAssump))) + Map.map (\p -> + do + assetFlows <- runPool p mAssumps (AP.interest =<< mNonPerfAssump) + let (poolCf, poolStatMap) = P.aggPool (P.issuanceStat p) assetFlows + return (poolCf, if flag then + Just $ fst <$> assetFlows + else + Nothing)) pm -runPoolType (ResecDeal dm) mAssumps mNonPerfAssump - -- = Map.foldrWithKey (\(DealBondFlow dn bn sd pct) (dname, cflow, stat) m -> - -- - -- Map.insert (DealBondFlow dname bn sd pct) (cflow, stat) m) - -- Map.empty $ - -- Map.mapWithKey (\(DealBondFlow dn bn sd pct) (uDeal, mAssump) -> - -- let - -- (poolAssump,dealAssump) = case mAssump of - -- Nothing -> (Nothing, AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing) - -- Just (_poolAssump, _dealAssump) -> (Just _poolAssump, _dealAssump) - -- in - -- do - -- (dealRunned, _, _, _) <- runDeal uDeal DealPoolFlowPricing poolAssump dealAssump - -- let bondFlow = cutBy Inc Future sd $ concat $ Map.elems $ Map.map Stmt.getTxns $ getBondStmtByName dealRunned (Just [bn]) -- `debug` ("Bondflow from underlying runned"++ show (getBondStmtByName dealRunned (Just [bn]))) - -- let bondFlowRated = (\(BondTxn d b i p r c di dioi f t) -> CF.BondFlow d b p i) <$> Stmt.scaleByFactor pct bondFlow -- `debug` ("Bondflow from underlying"++ show bondFlow) - -- return (name uDeal, CF.CashFlowFrame (0,sd,Nothing) bondFlowRated, Map.empty)) $ - -- Map.mapWithKey (\_ (UnderlyingDeal uDeal _ _ _) -> - -- let - -- dName = name uDeal -- `debug` ("Getting name of underlying deal:"++ (name uDeal)) - -- mAssump = case mAssumps of - -- Just (AP.ByDealName assumpMap) -> Map.lookup dName assumpMap - -- _ -> Nothing - -- in - -- (uDeal, mAssump)) - -- dm +runPoolType flag (ResecDeal dm) mAssumps mNonPerfAssump = let assumpMap = Map.mapWithKey (\_ (UnderlyingDeal uDeal _ _ _) -> @@ -1272,18 +1347,18 @@ runPoolType (ResecDeal dm) mAssumps mNonPerfAssump Just (_poolAssump, _dealAssump) -> (Just _poolAssump, _dealAssump) in do - (dealRunned, _, _, _) <- runDeal uDeal DealPoolFlowPricing poolAssump dealAssump - let bondFlow = cutBy Inc Future sd $ concat $ Map.elems $ Map.map (DL.toList . Stmt.getTxns) $ getBondStmtByName dealRunned (Just [bn]) -- `debug` ("Bondflow from underlying runned"++ show (getBondStmtByName dealRunned (Just [bn]))) - let bondFlowRated = (\(BondTxn d b i p r c di dioi f t) -> CF.BondFlow d b p i) <$> Stmt.scaleByFactor pct bondFlow -- `debug` ("Bondflow from underlying"++ show bondFlow) - return (CF.CashFlowFrame (0,sd,Nothing) bondFlowRated, Map.empty)) + (dealRunned, _, _, _,_) <- runDeal uDeal (S.fromList []) poolAssump dealAssump + let bondFlow = cutBy Inc Future sd $ concat $ Map.elems $ Map.map (DL.toList . Stmt.getTxns) $ getBondStmtByName dealRunned (Just [bn]) + let bondFlowRated = (\(BondTxn d b i p r c di dioi f t) -> CF.BondFlow d b p i) <$> Stmt.scaleByFactor pct bondFlow + return (CF.CashFlowFrame (0,sd,Nothing) bondFlowRated, Nothing)) assumpMap in sequenceA ranMap -getInits :: Ast.Asset a => TestDeal a -> Maybe AP.ApplyAssumptionType -> Maybe AP.NonPerfAssumption - -> Either String (TestDeal a,[ActionOnDate], Map.Map PoolId CF.CashFlowFrame, Map.Map PoolId CF.CashFlowFrame) -getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_stats} mAssumps mNonPerfAssump = +getInits :: Ast.Asset a => S.Set ExpectReturn -> TestDeal a -> Maybe AP.ApplyAssumptionType -> Maybe AP.NonPerfAssumption + -> Either String (TestDeal a,[ActionOnDate], Map.Map PoolId CF.PoolCashflow, Map.Map PoolId CF.PoolCashflow) +getInits er t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_stats} mAssumps mNonPerfAssump = let expandInspect sd ed (AP.InspectPt dp ds) = [ InspectDS _d [ds] | _d <- genSerialDatesTill2 II sd dp ed ] expandInspect sd ed (AP.InspectRpt dp dss) = [ InspectDS _d dss | _d <- genSerialDatesTill2 II sd dp ed ] @@ -1312,16 +1387,16 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s [ ResetLiqProviderRate _d _liqName |(_liqName,__liqResetDates) <- _liqRateResetDates , _d <- __liqResetDates ] --inspect dates let inspectDates = case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.inspectOn = Just inspectList } -> concat $ (expandInspect startDate endDate) <$> inspectList + Just AP.NonPerfAssumption{AP.inspectOn = Just inspectList } -> concatMap (expandInspect startDate endDate) inspectList _ -> [] let financialRptDates = case mNonPerfAssump of Just AP.NonPerfAssumption{AP.buildFinancialReport= Just dp } -> let - _ds = genSerialDatesTill2 II startDate dp endDate + (s:_ds) = genSerialDatesTill2 II startDate dp endDate in - [ BuildReport _sd _ed | (_sd,_ed) <- zip _ds (tail _ds) ] -- `debug` ("ds"++ show _ds) - _ -> [] -- `debug` ("emtpy rpt dates") + [ BuildReport _sd _ed | (_sd,_ed) <- zip (s:_ds) _ds ] -- `debug` ("ds"++ show _ds) + _ -> [] let irUpdateSwapDates = case rateSwap t of Nothing -> [] @@ -1401,12 +1476,15 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s Just AP.NonPerfAssumption{AP.callWhen = Just callOpts} -> concat [ extractTestDates callOpt | callOpt <- callOpts ] _ -> [] - + let stopTestDates = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.stopRunBy = Just (AP.StopByPre dp pres)} + -> [StopRunTest d pres | d <- genSerialDatesTill2 EI startDate dp endDate] + _ -> [] let allActionDates = let __actionDates = let a = concat [bActionDates,pActionDates,custWdates,iAccIntDates,makeWholeDate ,feeAccrueDates,liqResetDates,mannualTrigger,concat rateCapSettleDates - ,concat irUpdateSwapDates, concat irSettleSwapDates ,inspectDates, bndRateResets,financialRptDates + ,concat irUpdateSwapDates, concat irSettleSwapDates ,inspectDates, bndRateResets,financialRptDates, stopTestDates ,bondIssuePlan,bondRefiPlan,callDates, iAccRateResetDates ,bndStepUpDates] in @@ -1416,41 +1494,51 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s _actionDates = __actionDates++[HitStatedMaturity endDate] in case mNonPerfAssump of - Just AP.NonPerfAssumption{AP.stopRunBy = Just d} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d] + Just AP.NonPerfAssumption{AP.stopRunBy = Just (AP.StopByDate d)} -> cutBy Exc Past d __actionDates ++ [StopRunFlag d] _ -> _actionDates let newFeeMap = case mNonPerfAssump of Nothing -> feeMap Just AP.NonPerfAssumption{AP.projectedExpense = Nothing } -> feeMap - -- Just AP.NonPerfAssumption{AP.projectedExpense = Just (fn,projectedFlow) } - -- -> Map.adjust (\x -> x {F.feeType = F.FeeFlow projectedFlow}) fn feeMap Just AP.NonPerfAssumption{AP.projectedExpense = Just pairs } -> foldr (\(feeName,feeFlow) accM -> Map.adjust (\v -> v {F.feeType = F.FeeFlow feeFlow}) feeName accM) feeMap pairs - pCfM <- runPoolType thePool mAssumps mNonPerfAssump - pScheduleCfM <- runPoolType thePool Nothing mNonPerfAssump - let poolCfTsM = Map.map (\(CF.CashFlowFrame _ txns, pstats) -> cutBy Inc Future startDate txns) pCfM -- `debug` ("Pool cfm"++ show pCfM) - let poolCfTsMwithBegRow = Map.map (\case - (x:xs) -> buildBegTsRow startDate x:x:xs - [] -> []) - poolCfTsM - let poolAggCfM = Map.map (\x -> CF.aggTsByDates x (getDates pActionDates)) poolCfTsMwithBegRow - let pCollectionCfAfterCutoff = Map.map (\case - [] -> CF.CashFlowFrame (0,startDate,Nothing) [] - (txn:txns) -> CF.CashFlowFrame (CF.mflowBegBalance txn,startDate,Nothing) (txn:txns) ) - poolAggCfM -- `debug` ("Pool agg cfm"++ show (Map.map (sliceBy II (toDate "20241201") (toDate "20241231") ) poolAggCfM)) - let pTxnOfSpv = Map.map (\(CF.CashFlowFrame _ txns, pstats) -> cutBy Inc Future startDate txns) pScheduleCfM - let pAggCfM = Map.map (\case - [] -> [] - (x:xs) -> buildBegTsRow startDate x:x:xs) pTxnOfSpv - let pUnstressedAfterCutoff = Map.map (CF.CashFlowFrame (0,startDate,Nothing)) pAggCfM + pCfM <- runPoolType True thePool mAssumps mNonPerfAssump + pScheduleCfM <- runPoolType True thePool Nothing mNonPerfAssump + let aggDates = getDates pActionDates + let pCollectionCfAfterCutoff = Map.map + (\(pCf, mAssetFlow) -> + let + pCf' = CF.cutoffCashflow startDate aggDates pCf + in + (pCf' ,(\xs -> [ CF.cutoffCashflow startDate aggDates x | x <- xs ] ) <$> mAssetFlow) + ) + pCfM + + -- let pTxnOfSpv = Map.map (\((CF.CashFlowFrame _ txns, pstats), mAssetFlow) -> cutBy Inc Future startDate txns) pScheduleCfM + -- let pAggCfM = Map.map + -- (\case + -- [] -> [] + -- (x:xs) -> buildBegTsRow startDate x:x:xs) + -- pTxnOfSpv + -- let pUnstressedAfterCutoff = Map.map (CF.CashFlowFrame (0,startDate,Nothing)) pAggCfM + let pUnstressedAfterCutoff = Map.map + (\(pCf, mAssetFlow) -> + let + pCf' = CF.cutoffCashflow startDate aggDates pCf + in + (pCf' + ,(\xs -> [ CF.cutoffCashflow startDate aggDates x | x <- xs ]) <$> mAssetFlow) + ) + pScheduleCfM + let poolWithSchedule = patchScheduleFlow pUnstressedAfterCutoff thePool -- `debug` ("D") - let poolWithIssuanceBalance = patchIssuanceBalance status (Map.map - (\case - [] -> 0 - txns -> (CF.mflowBegBalance . head) txns) - poolAggCfM) - poolWithSchedule - let poolWithRunPoolBalance = patchRuntimeBal (Map.map (\(CF.CashFlowFrame (b,_,_) _) -> b) pCollectionCfAfterCutoff) poolWithIssuanceBalance + let poolWithIssuanceBalance = patchIssuanceBalance + status + ((\(_pflow,_) -> CF.getBegBalCashFlowFrame _pflow) <$> pCollectionCfAfterCutoff) + poolWithSchedule + let poolWithRunPoolBalance = patchRuntimeBal + (Map.map (\(CF.CashFlowFrame (b,_,_) _,_) -> b) pCollectionCfAfterCutoff) + poolWithIssuanceBalance let newStat = if (isPreClosing t) then _stats & (over _4) (`Map.union` (Map.fromList [(BondPaidPeriod,0),(PoolCollectedPeriod,0)])) @@ -1462,7 +1550,6 @@ getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap,stats=_s , pUnstressedAfterCutoff) -- ^ UI translation : to read pool cash --- TODO: need to make this a Maybe readProceeds :: PoolSource -> CF.TsRow -> Either String Balance readProceeds CollectedInterest x = Right $ CF.mflowInterest x readProceeds CollectedPrincipal x = Right $ CF.mflowPrincipal x @@ -1475,17 +1562,18 @@ readProceeds CollectedFeePaid x = Right $ CF.mflowFeePaid x readProceeds a _ = Left $ " Failed to find pool cashflow field from pool cashflow rule "++show a -extractTxnsFromFlowFrameMap :: Maybe [PoolId] -> Map.Map PoolId CF.CashFlowFrame -> [CF.TsRow] +extractTxnsFromFlowFrameMap :: Maybe [PoolId] -> Map.Map PoolId CF.PoolCashflow -> [CF.TsRow] extractTxnsFromFlowFrameMap mPids pflowMap = - case mPids of - Nothing -> extractTxns pflowMap - Just pids -> extractTxns $ Map.filterWithKey (\k _ -> k `elem` pids) pflowMap - where - extractTxns m = concat $ (view CF.cashflowTxn) <$> Map.elems m - -- extractTxns m = concatMap $ (view CF.cashflowTxn) $ Map.elems m + let + extractTxns :: Map.Map PoolId CF.PoolCashflow -> [CF.TsRow] + extractTxns m = concat $ (view (_1 . CF.cashflowTxn)) <$> Map.elems m + in + case mPids of + Nothing -> extractTxns pflowMap + Just pids -> extractTxns $ Map.filterWithKey (\k _ -> k `elem` pids) pflowMap -- ^ deposit cash to account by collection rule -depositInflow :: Date -> W.CollectionRule -> Map.Map PoolId CF.CashFlowFrame -> Map.Map AccountName A.Account -> Either String (Map.Map AccountName A.Account) +depositInflow :: Date -> W.CollectionRule -> Map.Map PoolId CF.PoolCashflow -> Map.Map AccountName A.Account -> Either String (Map.Map AccountName A.Account) depositInflow d (W.Collect mPids s an) pFlowMap amap = do amts <- sequenceA $ readProceeds s <$> txns @@ -1509,12 +1597,10 @@ depositInflow d (W.CollectByPct mPids s splitRules) pFlowMap amap --TODO need where txns = extractTxnsFromFlowFrameMap mPids pFlowMap -depositInflow _ a _ _ = Left $ " Failed to match collection rule "++ show a - -- ^ deposit cash to account by pool map CF and rules -depositPoolFlow :: [W.CollectionRule] -> Date -> Map.Map PoolId CF.CashFlowFrame -> Map.Map String A.Account -> Either String (Map.Map String A.Account) +depositPoolFlow :: [W.CollectionRule] -> Date -> Map.Map PoolId CF.PoolCashflow -> Map.Map String A.Account -> Either String (Map.Map String A.Account) depositPoolFlow rules d pFlowMap amap -- = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules = foldM (\acc rule -> depositInflow d rule pFlowMap acc) amap rules -$(deriveJSON defaultOptions ''ExpectReturn) \ No newline at end of file +$(deriveJSON defaultOptions ''ExpectReturn) diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 06f0104d..987f01e3 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -55,7 +55,7 @@ import Data.Time.Clock import Data.Maybe import Data.Either import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty +-- import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types @@ -280,7 +280,6 @@ calcDueInt t d b@(L.Bond bn bt bo (L.WithIoI intInfo ioiIntInfo) _ bond_bal bond ioiRate = case ioiIntInfo of L.OverCurrRateBy factor -> bond_rate * fromRational (1+factor) L.OverFixSpread spd -> bond_rate + spd - _ -> error "failed to match ioi rate type" newIoiInt = IR.calcInt intDue int_due_date d ioiRate DC_ACT_365F ioiInt = newIoiInt + ioiIntDue -- add ioi int due with new accrued ioi int newBond = b { L.bndDueIntOverInt = ioiInt, L.bndInterestInfo = intInfo } @@ -297,7 +296,6 @@ calcDueInt t d b@(L.MultiIntBond {}) calcDueInt t d b@(L.Bond {}) = Right $ L.accrueInt d b -- `debug` ("Hit to defualt accru"++ show (L.bndName b)) -calcDueInt t d b = error $ "Not implemented for calcDueInt for bond type" ++ show b -- ^ modify due principal for bond calcDuePrin :: Ast.Asset a => TestDeal a -> Date -> L.Bond -> Either String L.Bond @@ -375,7 +373,7 @@ buyRevolvingPool d r rp@(AssetCurve aus) data RunContext a = RunContext{ - runPoolFlow:: Map.Map PoolId CF.CashFlowFrame + runPoolFlow:: Map.Map PoolId CF.PoolCashflow ,revolvingAssump:: Maybe (Map.Map String (RevolvingPool ,AP.ApplyAssumptionType)) ,revolvingInterestRateAssump:: Maybe [RateAssumption] } @@ -568,16 +566,14 @@ performActionWrap d ResecDeal _ -> error "Not implement on buy resec deal" let newAccMap = Map.adjust (A.draw purchaseAmt d (PurchaseAsset revolvingPoolName boughtAssetBal)) accName accsMap -- `debug` ("Asset bought total bal"++ show boughtAssetBal) - cfFrameBought <- projAssetUnionList [updateOriginDate2 d ast | ast <- assetBought ] d perfAssumps mRates -- `debug` ("Date: " ++ show d ++ "Asset bought"++ show [updateOriginDate2 d ast | ast <- assetBought ]) - let cfBought = fst cfFrameBought -- `debug` ("In Buy>>>"++ show d ++"Cf bought"++ show (fst cfFrameBought)) - let newPcf = Map.adjust (\cfOrigin@(CF.CashFlowFrame st trs) -> + (cfBought ,_)<- projAssetUnionList [updateOriginDate2 d ast | ast <- assetBought ] d perfAssumps mRates -- `debug` ("Date: " ++ show d ++ "Asset bought"++ show [updateOriginDate2 d ast | ast <- assetBought ]) + let newPcf = Map.adjust (\(cfOrigin@(CF.CashFlowFrame st trs), mAflow) -> let - dsInterval = getDate <$> trs -- `debug` ("Date"++ show d ++ "origin cf \n"++ show cfOrigin) - boughtCfDates = getDate <$> view CF.cashflowTxn cfBought -- `debug` ("In Buy>>>"++"Date"++ show d++ "Cf bought 0\n"++ show cfBought) - + dsInterval = getDate <$> trs + boughtCfDates = getDate <$> view CF.cashflowTxn cfBought newAggDates = case (dsInterval,boughtCfDates) of ([],[]) -> [] - (_,[]) -> [] -- `debug` ("hit with non cash date from bought"++ show dsInterval) + (_,[]) -> [] ([],_) -> boughtCfDates (oDs,bDs) -> let @@ -588,12 +584,13 @@ performActionWrap d [] else sliceDates (SliceAfter lastOdate) bDs - - mergedCf = CF.mergePoolCf2 cfOrigin cfBought -- `debug` ("Buy Date : "++show d ++ "CF bought \n"++ show (over CF.cashflowTxn (slice 0 30) cfBought) ) + -- TODO: the cfOrigin may not have correct beg balance ,which doesn't match all the amortization of cashflow txn + mergedCf = CF.mergePoolCf2 cfOrigin cfBought in - over CF.cashflowTxn (`CF.aggTsByDates` (dsInterval ++ newAggDates)) mergedCf )-- `debug` ("In Buy>>>"++"Date "++show d++" Merged CF\n"++ show mergedCf)) + ((over CF.cashflowTxn (`CF.aggTsByDates` (dsInterval ++ newAggDates)) mergedCf), (++ [cfBought]) <$> mAflow) + ) pIdToChange - pFlowMap -- `debug` ("pid To change"++ show pIdToChange++ "P flow map"++ show pFlowMap) + pFlowMap let newRc = rc {runPoolFlow = newPcf -- `debug` ("In Buy>>>"++show d ++ "New run pool >> \n"++ show newPcf) ,revolvingAssump = Just (Map.insert revolvingPoolName (poolAfterBought, perfAssumps) rMap)} @@ -624,8 +621,8 @@ performActionWrap d (W.LiquidatePool lm an mPid) = let liqFunction = \(p@P.Pool{ P.issuanceStat = m} ) - -> over (P.poolFutureScheduleCf . _Just) (CF.extendCashFlow d) $ - over (P.poolFutureCf . _Just) (CF.extendCashFlow d) $ + -> over (P.poolFutureScheduleCf . _Just . _1) (CF.extendCashFlow d) $ + over (P.poolFutureCf . _Just . _1 ) (CF.extendCashFlow d) $ p { P.issuanceStat = Just (Map.insert RuntimeCurrentPoolBalance 0 (fromMaybe Map.empty m)) } poolMapToLiq = case (pt, mPid) of @@ -655,7 +652,7 @@ performActionWrap d liqComment = LiquidationProceeds (fromMaybe [] mPid) accMapAfterLiq = Map.adjust (A.deposit liqAmt d liqComment) an accMap -- REMOVE future cf - newPfInRc = foldr (Map.adjust (set CF.cashflowTxn [])) pcf (Map.keys poolMapToLiq) + newPfInRc = foldr (Map.adjust (set (_1 . CF.cashflowTxn) [])) pcf (Map.keys poolMapToLiq) -- Update current balance to zero in Right (t {accounts = accMapAfterLiq , pool = newPt} , rc {runPoolFlow = newPfInRc}, logs) diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index 6b0ab338..41eb75c6 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -8,13 +8,14 @@ module Deal.DealBase (TestDeal(..),SPV(..),dealBonds,dealFees,dealAccounts,dealPool,PoolType(..),getIssuanceStats ,getAllAsset,getAllAssetList,getAllCollectedFrame,getLatestCollectFrame,getAllCollectedTxns - ,getIssuanceStatsConsol,getAllCollectedTxnsList,dealScheduledCashflow - ,getPoolIds,getBondByName, UnderlyingDeal(..),dealCashflow, uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..) + ,getIssuanceStatsConsol,getAllCollectedTxnsList + ,getPoolIds,getBondByName, UnderlyingDeal(..), uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..) ,sortActionOnDate,dealBondGroups ,viewDealBondsByNames,poolTypePool,viewBondsInMap,bondGroupsBonds ,increaseBondPaidPeriod,increasePoolCollectedPeriod ,DealStatFields(..),getDealStatInt,isPreClosing,populateDealDates - ,bondTraversal,findBondByNames + ,bondTraversal,findBondByNames,updateBondInMap + ,_MultiPool,_ResecDeal,uDealFutureCf,uDealFutureScheduleCf ) where import qualified Accounts as A @@ -47,7 +48,6 @@ import Data.Fixed import Data.Maybe import Data.Ratio import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types @@ -106,6 +106,7 @@ data ActionOnDate = EarnAccInt Date AccName -- ^ sweep bank account | RefiBond Date AccountName L.Bond | BuildReport StartDate EndDate -- ^ build cashflow report between dates and balance report at end date | StopRunFlag Date -- ^ stop the run with a message + | StopRunTest Date [Pre] -- ^ stop the run with a condition | HitStatedMaturity Date -- ^ hit the stated maturity date | TestCall Date -- ^ test call dates deriving (Show,Generic,Read) @@ -141,6 +142,8 @@ instance TimeSeries ActionOnDate where getDate (ResetLiqProviderRate d _) = d getDate (TestCall d) = d getDate (FundBond d _ _ _ _) = d + getDate (HitStatedMaturity d) = d + getDate (StopRunTest d _) = d getDate x = error $ "Failed to match"++ show x @@ -268,20 +271,44 @@ class SPV a where getOustandingBal :: a -> Balance +type BalDealStatMap = Map.Map DealStatFields Balance +type RDealStatMap = Map.Map DealStatFields Rate +type BDealStatMap = Map.Map DealStatFields Bool +type IDealStatMap = Map.Map DealStatFields Int + +data TestDeal a = TestDeal { name :: DealName + ,status :: DealStatus + ,dates :: DateDesp + ,accounts :: Map.Map AccountName A.Account + ,fees :: Map.Map FeeName F.Fee + ,bonds :: Map.Map BondName L.Bond + ,pool :: PoolType a + ,waterfall :: Map.Map W.ActionWhen W.DistributionSeq + ,collects :: [W.CollectionRule] + ,stats :: (BalDealStatMap,RDealStatMap,BDealStatMap,IDealStatMap) + ,liqProvider :: Maybe (Map.Map String CE.LiqFacility) + ,rateSwap :: Maybe (Map.Map String HE.RateSwap) + ,rateCap :: Maybe (Map.Map String HE.RateCap) + ,currencySwap :: Maybe (Map.Map String HE.CurrencySwap) + ,custom:: Maybe (Map.Map String CustomDataType) + ,triggers :: Maybe (Map.Map DealCycle (Map.Map String Trigger)) + ,ledgers :: Maybe (Map.Map String LD.Ledger) + } deriving (Show,Generic,Eq,Ord) + data UnderlyingDeal a = UnderlyingDeal { deal :: TestDeal a - ,futureCf :: Maybe CF.CashFlowFrame - ,futureScheduleCf :: Maybe CF.CashFlowFrame + ,futureCf :: CF.CashFlowFrame + ,futureScheduleCf :: CF.CashFlowFrame ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) } deriving (Generic,Eq,Ord,Show) -uDealFutureScheduleCf :: Ast.Asset a => Lens' (UnderlyingDeal a) (Maybe CF.CashFlowFrame) +uDealFutureScheduleCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame uDealFutureScheduleCf = lens getter setter where getter = futureScheduleCf setter ud newCf = ud {futureScheduleCf = newCf} -uDealFutureCf :: Ast.Asset a => Lens' (UnderlyingDeal a) (Maybe CF.CashFlowFrame) +uDealFutureCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame uDealFutureCf = lens getter setter where getter = futureCf @@ -290,45 +317,22 @@ uDealFutureCf = lens getter setter uDealFutureTxn :: Ast.Asset a => Lens' (UnderlyingDeal a) [CF.TsRow] uDealFutureTxn = lens getter setter where - getter ud = fromMaybe [] $ (view CF.cashflowTxn) <$> futureCf ud - setter ud newTxn = - let - mOriginalCfFrame = futureCf ud - - in - case mOriginalCfFrame of - Nothing -> ud {futureCf = Just (CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn)} - Just (CF.CashFlowFrame (begBal,begDate,mInt) txns) -> ud {futureCf = Just (CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn) } + getter ud = view CF.cashflowTxn $ futureCf ud + setter ud newTxn = ud {futureCf = CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn} + -- let + -- mOriginalCfFrame = futureCf ud + -- in + -- case mOriginalCfFrame of + -- + -- (CF.CashFlowFrame (begBal,begDate,mInt) txns) -> ud {futureCf = CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn } data PoolType a = MultiPool (Map.Map PoolId (P.Pool a)) | ResecDeal (Map.Map PoolId (UnderlyingDeal a)) deriving (Generic, Eq, Ord, Show) +makePrisms ''PoolType -type BalDealStatMap = Map.Map DealStatFields Balance -type RDealStatMap = Map.Map DealStatFields Rate -type BDealStatMap = Map.Map DealStatFields Bool -type IDealStatMap = Map.Map DealStatFields Int - -data TestDeal a = TestDeal { name :: DealName - ,status :: DealStatus - ,dates :: DateDesp - ,accounts :: Map.Map AccountName A.Account - ,fees :: Map.Map FeeName F.Fee - ,bonds :: Map.Map BondName L.Bond - ,pool :: PoolType a - ,waterfall :: Map.Map W.ActionWhen W.DistributionSeq - ,collects :: [W.CollectionRule] - ,stats :: (BalDealStatMap,RDealStatMap,BDealStatMap,IDealStatMap) - ,liqProvider :: Maybe (Map.Map String CE.LiqFacility) - ,rateSwap :: Maybe (Map.Map String HE.RateSwap) - ,rateCap :: Maybe (Map.Map String HE.RateCap) - ,currencySwap :: Maybe (Map.Map String HE.CurrencySwap) - ,custom:: Maybe (Map.Map String CustomDataType) - ,triggers :: Maybe (Map.Map DealCycle (Map.Map String Trigger)) - ,ledgers :: Maybe (Map.Map String LD.Ledger) - } deriving (Show,Generic,Eq,Ord) instance SPV (TestDeal a) where getBondsByName t bns @@ -473,6 +477,16 @@ bondGroupsBonds = lens getter setter setter (L.BondGroup b x) newBMap = L.BondGroup newBMap x setter x _ = x +updateBondInMap :: BondName -> (L.Bond -> L.Bond) -> Map.Map BondName L.Bond -> Map.Map BondName L.Bond +updateBondInMap bName f bMap + = let + fn _bName (L.BondGroup subMap bt) = L.BondGroup (Map.adjust f _bName subMap) bt + fn _bName bnd + | _bName == bName = f bnd + | otherwise = bnd + in + Map.mapWithKey fn bMap + dealAccounts :: Ast.Asset a => Lens' (TestDeal a) (Map.Map AccountName A.Account) dealAccounts = lens getter setter where @@ -491,7 +505,6 @@ dealPool = lens getter setter getter d = pool d setter d newPool = d {pool = newPool} - poolTypePool :: Ast.Asset a => Lens' (PoolType a) (Map.Map PoolId (P.Pool a)) poolTypePool = lens getter setter where @@ -504,42 +517,47 @@ poolTypeUnderDeal = lens getter setter getter = \case ResecDeal dm -> dm setter (ResecDeal dm) newDm = ResecDeal newDm -dealScheduledCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId (Maybe CF.CashFlowFrame)) -dealScheduledCashflow = lens getter setter - where - getter d = case pool d of - MultiPool pm -> Map.map P.futureScheduleCf pm - ResecDeal uds -> Map.map futureScheduleCf uds - x -> error $ "Failed to match :" ++ show x - setter d newCfMap = case pool d of - MultiPool pm -> let - newPm = Map.mapWithKey (\k p -> set P.poolFutureScheduleCf (newCfMap Map.! k) p) pm - in - set dealPool (MultiPool newPm) d - ResecDeal pm -> - let - newPm = Map.mapWithKey (\k ud -> - set uDealFutureScheduleCf (newCfMap Map.! k) ud) pm - in - set dealPool (ResecDeal newPm) d - -dealCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId (Maybe CF.CashFlowFrame)) -dealCashflow = lens getter setter - where - getter d = case pool d of - MultiPool pm -> Map.map P.futureCf pm - ResecDeal uds -> Map.map futureCf uds - setter d newCfMap = case pool d of - MultiPool pm -> let - newPm = Map.mapWithKey (\k p -> set P.poolFutureCf (newCfMap Map.! k) p) pm - in - set dealPool (MultiPool newPm) d - ResecDeal pm -> - let - newPm = Map.mapWithKey (\k ud -> - set uDealFutureCf (newCfMap Map.! k) ud) pm - in - set dealPool (ResecDeal newPm) d +-- schedulePoolFlowLens = poolTypePool . mapped . P.futureScheduleCfLens +-- schedulePoolFlowAggLens = schedulePoolFlowLens . _1 . _1 +-- scheduleBondFlowLens = poolTypeUnderDeal . mapped . uDealFutureScheduleCf + + +-- dealInputCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId CF.PoolCashflow) +-- dealInputCashflow = lens getter setter +-- where +-- getter d = case pool d of +-- MultiPool pm -> Map.map (P.futureScheduleCf) pm +-- ResecDeal uds -> Map.map futureScheduleCf uds +-- setter d newCfMap = case pool d of +-- MultiPool pm -> +-- let +-- newPm = Map.mapWithKey (\k p -> set (P.poolFutureScheduleCf) (newCfMap Map.! k) p) pm +-- in +-- set dealPool (MultiPool newPm) d +-- ResecDeal pm -> +-- let +-- newPm = Map.mapWithKey (\k ud ->gset uDealFutureScheduleCf (newCfMap Map.! k) ud) pm +-- in +-- set dealPool (ResecDeal newPm) d + +-- dealCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId (Maybe CF.CashFlowFrame)) +-- dealCashflow = lens getter setter +-- where +-- getter d = case pool d of +-- MultiPool pm -> Map.map P.futureCf pm +-- ResecDeal uds -> Map.map futureCf uds +-- setter d newCfMap = case pool d of +-- MultiPool pm -> let +-- newPm = Map.mapWithKey (\k p -> set P.poolFutureCf (newCfMap Map.! k) p) pm +-- in +-- set dealPool (MultiPool newPm) d +-- ResecDeal pm -> +-- let +-- newPm = Map.mapWithKey +-- (\k ud -> set uDealFutureCf (newCfMap Map.! k) ud) +-- pm +-- in +-- set dealPool (ResecDeal newPm) d getPoolIds :: Ast.Asset a => TestDeal a -> [PoolId] getPoolIds t@TestDeal{pool = pt} @@ -597,10 +615,12 @@ getAllAsset t@TestDeal{pool = pt} mPns = getAllAssetList :: Ast.Asset a => TestDeal a -> [a] getAllAssetList t = concat $ Map.elems (getAllAsset t Nothing) -getAllCollectedFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe CF.CashFlowFrame) -getAllCollectedFrame t mPid = +getAllCollectedFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId CF.CashFlowFrame +getAllCollectedFrame t@TestDeal{pool = poolType} mPid = let - mCf = view dealCashflow t + mCf = case poolType of + MultiPool pm -> Map.map (view (P.poolFutureCf . _Just . _1 )) pm -- `debug` ("MultiPool" ++ show pm) + ResecDeal uds -> Map.map futureCf uds in case mPid of Nothing -> mCf -- `debug` ("Nothing when collecting cfs"++show mCf) @@ -608,18 +628,17 @@ getAllCollectedFrame t mPid = getLatestCollectFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe CF.TsRow) getLatestCollectFrame t mPns = Map.map (\case - Nothing -> Nothing - (Just (CF.CashFlowFrame (_,_,_) [])) -> Nothing - (Just (CF.CashFlowFrame (_,_,_) txns)) -> Just $ last txns + (CF.CashFlowFrame (_,_,_) []) -> Nothing + (CF.CashFlowFrame (_,_,_) txns) -> Just $ last txns ) (getAllCollectedFrame t mPns) -getAllCollectedTxns :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe [CF.TsRow]) -getAllCollectedTxns t mPns = Map.map (view CF.cashflowTxn <$>) (getAllCollectedFrame t mPns) +getAllCollectedTxns :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId [CF.TsRow] +getAllCollectedTxns t mPns = Map.map (view CF.cashflowTxn) (getAllCollectedFrame t mPns) getAllCollectedTxnsList :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> [CF.TsRow] getAllCollectedTxnsList t mPns - = concat $ fromMaybe [] <$> listOfTxns + = concat listOfTxns where listOfTxns = Map.elems $ getAllCollectedTxns t mPns diff --git a/src/Deal/DealMod.hs b/src/Deal/DealMod.hs index 93ab679f..afbec6c5 100644 --- a/src/Deal/DealMod.hs +++ b/src/Deal/DealMod.hs @@ -48,7 +48,7 @@ import Data.Fixed import Data.Maybe import Data.Ratio import Data.Aeson hiding (json) -import qualified Data.Aeson.Encode.Pretty as Pretty +-- import qualified Data.Aeson.Encode.Pretty as Pretty import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types @@ -71,7 +71,7 @@ data AdjStrategy = ScaleBySpread deriving (Show,Generic) data ModifyType = AddSpreadToBonds BondName - | ScaleBondBalByRate + | SlideBalances BondName BondName deriving (Show,Generic) -- ^ Modify a deal by various type of recipes @@ -87,6 +87,17 @@ modDeal (AddSpreadToBonds bnd) sprd d bndMap in d {DB.bonds = bndMap'} + +modDeal (SlideBalances bn1 bn2) r d@DB.TestDeal {DB.bonds = bndMap} + = let + totalBalance = sum $ L.originBalance . L.bndOriginInfo <$> DB.viewDealBondsByNames d [bn1, bn2] + leftBal = mulBR totalBalance (toRational r) -- `debug` ("split ratio" ++ show r) + rightBal = totalBalance - leftBal + bndMap' = DB.updateBondInMap bn1 (L.adjustBalance leftBal) $ + DB.updateBondInMap bn2 (L.adjustBalance rightBal) bndMap -- `debug` ("leftBal: " ++ show leftBal ++ ", rightBal: " ++ show rightBal ) + in + d {DB.bonds = bndMap'} + modDeal x _ _ = error $ "modify deal: not implemented"++ show x @@ -94,4 +105,4 @@ $(deriveJSON defaultOptions ''AdjStrategy) instance ToSchema AdjStrategy $(deriveJSON defaultOptions ''ModifyType) -instance ToSchema ModifyType \ No newline at end of file +instance ToSchema ModifyType diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index 4f56de0e..b527f62c 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -12,6 +12,7 @@ module Deal.DealQuery (queryDealBool ,patchDateToStats,patchDatesToStats,testPre import Deal.DealBase import Types import qualified Asset as P +import qualified AssetClass.AssetBase as AB import Data.List import Data.Fixed import Data.Maybe @@ -33,6 +34,7 @@ import qualified CreditEnhancement as CE import qualified Hedge as H import qualified Analytics as A import qualified Pool as Pl +import qualified InterestRate as IR import Stmt import Util import Errors @@ -269,6 +271,20 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f in Right $ sum rates + --TODO need to use projected current balance instead of current balance + PoolWaSpread mPns -> + let + assets = getAllAsset t mPns + bals = P.getCurrentBal <$> concat (Map.elems assets) + spreads = map + (\case + AB.MortgageOriginalInfo { AB.originRate = r } -> fromMaybe 0.0 $ IR._getSpread r + AB.LoanOriginalInfo { AB.originRate = r } -> fromMaybe 0.0 $ IR._getSpread r + _ -> 0.0) + (P.getOriginInfo <$> concat (Map.elems assets)) + in + Right $ weightedBy (toRational <$> bals) (toRational <$> spreads) + DealStatRate s -> case stats t of (_,m,_,_) -> case Map.lookup s m of @@ -283,6 +299,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f poolBn = maybe 0 (fromMaybe 0 . CF.mflowBorrowerNum) <$> poolCfs in Right . toRational $ sum poolBn + CurrentPoolBorrowerNum mPns -> let assetM = concat $ Map.elems $ getAllAsset t mPns @@ -296,7 +313,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f Nothing -> Left $ "Date:"++show d++"There is maturity date for bond " ++ bn Just md -> Right . toRational $ T.cdMonths $ T.diffGregorianDurationClip md d - ProjCollectPeriodNum -> Right . toRational $ maximum' $ Map.elems $ Map.map (maybe 0 CF.sizeCashFlowFrame) $ getAllCollectedFrame t Nothing + ProjCollectPeriodNum -> Right . toRational $ maximum' $ Map.elems $ Map.map CF.sizeCashFlowFrame $ getAllCollectedFrame t Nothing DealStatInt s -> case stats t of @@ -406,17 +423,17 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f Left $ "Date:"++show d++"Failed to find pool balance" ++ show pids ++ " from deal "++ show (Map.keys pm) _ -> Left $ "Date:"++show d++"Failed to find pool" ++ show mPns ++","++ show pt - FutureCurrentSchedulePoolBalance mPns -> - let - scheduleFlowM = Map.elems $ view dealScheduledCashflow t - in - Right . toRational $ sum $ maybe 0 ((view CF.tsRowBalance) . head . view CF.cashflowTxn) <$> scheduleFlowM - - FutureCurrentSchedulePoolBegBalance mPns -> - let - scheduleFlowM = Map.elems $ view dealScheduledCashflow t - in - Right . toRational $ sum $ maybe 0 (CF.mflowBegBalance . head . view CF.cashflowTxn) <$> scheduleFlowM +-- FutureCurrentSchedulePoolBalance mPns -> +-- let +-- scheduleFlowM = Map.elems $ view dealScheduledCashflow t +-- in +-- Right . toRational $ sum $ ((view CF.tsRowBalance) . head . view CF.cashflowTxn) <$> scheduleFlowM +-- +-- FutureCurrentSchedulePoolBegBalance mPns -> +-- let +-- scheduleFlowM = Map.elems $ view dealScheduledCashflow t +-- in +-- Right . toRational $ sum $ (CF.mflowBegBalance . head . view CF.cashflowTxn) <$> scheduleFlowM FutureCurrentPoolBegBalance mPns -> let @@ -428,7 +445,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f Right . toRational $ sum fieldAmts where mTxns = Map.elems $ getAllCollectedTxns t mPns - subflow = sliceBy EI fromDay asOfDay $ concat $ fromMaybe [] <$> mTxns + subflow = sliceBy EI fromDay asOfDay $ concat mTxns fieldAmts = map (`CF.lookupSource` incomeType) subflow CumulativePoolDefaultedBalance mPns -> @@ -453,7 +470,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f PoolCumCollection ps mPns -> let - collectedTxns = concat . Map.elems $ Map.map (fromMaybe []) $ getAllCollectedTxns t mPns + collectedTxns = concat . Map.elems $ getAllCollectedTxns t mPns futureVals = sum $ (CF.lookupSource <$> collectedTxns) <*> ps poolStats = Map.elems $ getIssuanceStats t mPns @@ -463,7 +480,7 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f PoolCumCollectionTill idx ps mPns -> let - txnMap = Map.map (dropLastN (negate idx) . fromMaybe []) $ getAllCollectedTxns t mPns + txnMap = Map.map (dropLastN (negate idx)) $ getAllCollectedTxns t mPns txnList = concat $ Map.elems txnMap lookupList = CF.lookupSource <$> txnList futureVals = sum $ lookupList <*> ps @@ -483,10 +500,9 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f let pCollectedTxns = getAllCollectedTxns t mPns pStat = Map.map - (\_x -> + (\x -> let lookupIndx = length x + idx - 1 - x = fromMaybe [] _x in if (( lookupIndx >= length x ) || (lookupIndx <0)) then Nothing @@ -509,8 +525,10 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f FuturePoolScheduleCfPv asOfDay pm mPns -> let - pScheduleFlow = view dealScheduledCashflow t - pCfTxns = Map.map (maybe [] (view CF.cashflowTxn)) $ + pScheduleFlow::(Map.Map PoolId CF.CashFlowFrame) = case pt of + MultiPool poolMap -> Map.map (\p -> view (Pl.poolFutureScheduleCf . _Just . _1) p) poolMap + -- ResecDeal dealMap -> Map.map (view uDealFutureScheduleCf) dealMap + pCfTxns::(Map.Map PoolId [CF.TsRow]) = Map.map (view CF.cashflowTxn) $ case mPns of Nothing -> pScheduleFlow Just pIds -> Map.filterWithKey (\k _ -> S.member k (S.fromList pIds)) pScheduleFlow @@ -710,11 +728,10 @@ queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=f WeightedAvgCurrentPoolBalance d1 d2 mPns -> let - txnsByPool = getAllCollectedTxns t mPns - waBalByPool = Map.map (CF.mflowWeightAverageBalance d1 d2 <$>) txnsByPool + txnsByPool::(Map.Map PoolId [CF.TsRow]) = getAllCollectedTxns t mPns + waBalByPool::(Map.Map PoolId Balance) = Map.map (CF.mflowWeightAverageBalance d1 d2) txnsByPool in - Right . toRational $ - sum $ fromMaybe 0 <$> Map.elems waBalByPool + Right . toRational $ sum $ Map.elems waBalByPool WeightedAvgOriginalBondBalance d1 d2 bns -> let @@ -998,4 +1015,4 @@ preToStr t d p = ps = patchDateToStats d testPre2 :: P.Asset a => Date -> TestDeal a -> Pre -> (String, Either String Bool) -testPre2 d t p = (preToStr t d p, testPre d t p) \ No newline at end of file +testPre2 d t p = (preToStr t d p, testPre d t p) diff --git a/src/Deal/DealValidation.hs b/src/Deal/DealValidation.hs index 23b44a46..427553fc 100644 --- a/src/Deal/DealValidation.hs +++ b/src/Deal/DealValidation.hs @@ -485,6 +485,7 @@ validatePreRun t@TestDeal{waterfall=waterfallM in (warnings,allErrors) -- Valiation Pass +-- validate deal object after run validateRun :: TestDeal a -> [ResultComponent] validateRun t@TestDeal{waterfall=waterfallM ,accounts =accM diff --git a/src/InterestRate.hs b/src/InterestRate.hs index 47418a30..555de452 100644 --- a/src/InterestRate.hs +++ b/src/InterestRate.hs @@ -5,7 +5,8 @@ module InterestRate (ARM(..),RateType(..),runInterestRate2,runInterestRate,UseRate(..) - ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve) + ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve + ,getSpread,_getSpread) where @@ -43,6 +44,9 @@ getDayCount :: RateType -> DayCount getDayCount (Fix dc _) = dc getDayCount (Floater dc _ _ _ _ _ _ _ ) = dc +_getSpread :: RateType -> Maybe Spread +_getSpread (Fix _ _) = Nothing +_getSpread (Floater _ _ spd _ _ _ _ _) = Just spd data ARM = ARM InitPeriod InitCap PeriodicCap LifetimeCap RateFloor | OtherARM @@ -108,6 +112,7 @@ class UseRate x where getIndex :: x -> Maybe Index getIndexes :: x -> Maybe [Index] getResetDates :: x -> Dates + getSpread :: x -> Maybe Spread $(deriveJSON defaultOptions ''ARM) diff --git a/src/Liability.hs b/src/Liability.hs index c8095bc8..cebe1320 100644 --- a/src/Liability.hs +++ b/src/Liability.hs @@ -20,7 +20,7 @@ module Liability ,getCurRate,bondCashflow,getOutstandingAmount,valueBond,getTxnRate ,getAccrueBegDate,getTxnInt,adjInterestInfoByRate,adjInterestInfoBySpread ,interestInfoTraversal,getOriginBalance,curRatesTraversal - ,backoutAccruedInt + ,backoutAccruedInt,extractIrrResult,adjustBalance ) where @@ -246,6 +246,9 @@ curRatesTraversal f (MultiIntBond bn bt oi iis sus bal rs dp dis diois did lips curRatesTraversal f (BondGroup bMap x) = BondGroup <$> traverse (curRatesTraversal f) bMap <*> pure x +adjustBalance :: Balance -> Bond -> Bond +adjustBalance bal b@Bond{bndBalance = _, bndOriginInfo = oi } + = b {bndBalance = bal, bndOriginInfo = oi {originBalance = bal}} bndmStmt :: Lens' Bond (Maybe S.Statement) bndmStmt = lens getter setter @@ -533,6 +536,9 @@ priceBond d rc bnd valueBond :: BondPricingMethod -> Date -> [(Date,Balance)] -> Balance valueBond _ _ [] = 0 +extractIrrResult :: PriceResult -> Maybe IRR +extractIrrResult priceResult = fst <$> preview _IrrResult priceResult + backoutAccruedInt :: Date -> Date -> [Txn] -> Amount backoutAccruedInt d txnStartDate txns = case splitByDate txns d EqToLeft of diff --git a/src/Lib.hs b/src/Lib.hs index fad28acd..051cee78 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -27,7 +27,7 @@ import Language.Haskell.TH import Data.Aeson.TH import Data.Aeson.Types import Data.Aeson hiding (json) -import Text.Regex.TDFA +-- import Text.Regex.TDFA import Data.Fixed (Fixed(..), HasResolution,Centi, resolution) import Data.Ratio import Types @@ -240,4 +240,4 @@ nextDate d p Quarterly -> 3 SemiAnnually -> 6 Annually -> 12 - _ -> 0 \ No newline at end of file + _ -> 0 diff --git a/src/Pool.hs b/src/Pool.hs index d21d2f6e..4d23edbe 100644 --- a/src/Pool.hs +++ b/src/Pool.hs @@ -4,16 +4,17 @@ module Pool (Pool(..),aggPool ,getIssuanceField - ,poolFutureCf,poolFutureTxn,poolIssuanceStat + ,poolFutureCf,poolIssuanceStat ,poolFutureScheduleCf - ,poolBegStats,poolFutureCf2,calcLiquidationAmount,pricingPoolFlow + ,poolBegStats,calcLiquidationAmount,pricingPoolFlow + ,futureScheduleCfLens,futureCfLens, poolFutureCf ) where import Lib (Period(..) ,Ts(..),periodRateFromAnnualRate,toDate ,getIntervalDays,zipWith9,mkTs,periodsBetween - ,mkRateTs,daysBetween) + ,mkRateTs,daysBetween, ) import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) import qualified Assumptions as A @@ -32,7 +33,7 @@ import Data.Aeson.Types import Types hiding (Current) import Data.Maybe -import Control.Lens hiding (element) +import Control.Lens import Control.Lens.TH import Assumptions (ApplyAssumptionType) @@ -44,42 +45,27 @@ debug = flip trace data Pool a = Pool {assets :: [a] -- ^ a list of assets in the pool - ,futureCf :: Maybe CF.CashFlowFrame -- ^ projected cashflow from the assets in the pool - ,futureScheduleCf :: Maybe CF.CashFlowFrame -- ^ projected un-stressed cashflow + ,futureCf :: Maybe CF.PoolCashflow -- ^ collected cashflow from the assets in the pool + ,futureScheduleCf :: Maybe CF.PoolCashflow -- ^ collected un-stressed cashflow ,asOfDate :: Date -- ^ include cashflow after this date ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) -- ^ cutoff balance of pool ,extendPeriods :: Maybe DatePattern -- ^ dates for extend pool collection } deriving (Show, Generic, Ord, Eq) +makeLensesFor [("futureCf","futureCfLens"),("futureScheduleCf","futureScheduleCfLens")] ''Pool -poolFutureCf :: Asset a => Lens' (Pool a) (Maybe CF.CashFlowFrame) +poolFutureCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow) poolFutureCf = lens getter setter where - getter p = futureCf p + getter = futureCf setter p mNewCf = p {futureCf = mNewCf} -poolFutureCf2 :: Asset a => Lens' (Pool a) CF.CashFlowFrame -poolFutureCf2 = lens getter setter - where - getter p = fromMaybe (CF.CashFlowFrame (0,toDate "19000101",Nothing) []) $ futureCf p - setter p newCf = p {futureCf = Just newCf} - -poolFutureScheduleCf :: Asset a => Lens' (Pool a) (Maybe CF.CashFlowFrame) +poolFutureScheduleCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow) poolFutureScheduleCf = lens getter setter where - getter p = futureScheduleCf p + getter = futureScheduleCf setter p mNewCf = p {futureScheduleCf = mNewCf} -poolFutureTxn :: Asset a => Lens' (Pool a) [CF.TsRow] -poolFutureTxn = lens getter setter - where - getter p = case futureCf p of - Nothing -> []::[CF.TsRow] - Just (CF.CashFlowFrame _ txns) -> txns - setter p trs = case futureCf p of - Nothing -> p {futureCf = Just (CF.CashFlowFrame (0,toDate "19000101",Nothing) trs)} --TODO fix this - Just (CF.CashFlowFrame st _) -> p {futureCf = Just (CF.CashFlowFrame st trs)} - poolIssuanceStat :: Asset a => Lens' (Pool a) (Map.Map CutoffFields Balance) poolIssuanceStat = lens getter setter where @@ -146,8 +132,8 @@ aggPool mStat xs calcLiquidationAmount :: Asset a => PricingMethod -> Pool a -> Date -> Amount calcLiquidationAmount (BalanceFactor currentFactor defaultFactor ) pool d = case futureCf pool of - Nothing -> 0 -- `debug` ("No futureCF") - Just _futureCf@(CF.CashFlowFrame _ trs) -> + Just (CF.CashFlowFrame _ [],_) -> 0 + Just _futureCf@(CF.CashFlowFrame _ trs,_) -> let earlierTxns = cutBy Inc Past d trs currentCumulativeDefaultBal = sum $ map (\x -> CF.mflowDefault x - CF.mflowRecovery x - CF.mflowLoss x) earlierTxns @@ -162,10 +148,10 @@ calcLiquidationAmount (BalanceFactor currentFactor defaultFactor ) pool d -- | pricing via future scheduled cashflow( zero risk adjust) -- | pricing via user define risk adjust cashflow( own assumption) -- TODO: in revolving buy future schedule cashflow should be updated as well -calcLiquidationAmount (PV discountRate recoveryPct) pool d +calcLiquidationAmount (PV discountRate recoveryPct) pool d = case futureCf pool of - Nothing -> 0 - Just (CF.CashFlowFrame _ trs) -> + Just (CF.CashFlowFrame _ [],_) -> 0 + Just (CF.CashFlowFrame _ trs,_) -> let futureTxns = cutBy Inc Future d trs -- `debug` (" pv date"++show d++ " with rate"++show discountRate) earlierTxns = cutBy Exc Past d trs -- `debug` ("Total txn"++show trs) @@ -177,22 +163,16 @@ calcLiquidationAmount (PV discountRate recoveryPct) pool d pvCf + mulBR currentDefaulBal recoveryPct -- ^ price a pool with collected cashflow and future cashflow -pricingPoolFlow :: Asset a => Date -> Pool a -> CashFlowFrame -> PricingMethod -> Amount -pricingPoolFlow d pool@Pool{ futureCf = mCollectedCf, issuanceStat = mStat } futureCfUncollected pm +pricingPoolFlow :: Asset a => Date -> Pool a -> CF.PoolCashflow -> PricingMethod -> Amount +pricingPoolFlow d pool@Pool{ futureCf = Just (mCollectedCf,_), issuanceStat = mStat } (futureCfUncollected,_) pm = let - currentCumulativeDefaultBal = case mCollectedCf of - Nothing -> 0 - Just collectedCf -> - let - collectedTxns = view CF.cashflowTxn collectedCf - in - if null collectedTxns then - 0 - else - let - lastTxn = last collectedTxns - in - fromMaybe 0 (CF.tsCumDefaultBal lastTxn) - fromMaybe 0 (CF.tsCumRecoveriesBal lastTxn) - fromMaybe 0 (CF.tsCumLossBal lastTxn) + currentCumulativeDefaultBal + | CF.emptyCashFlowFrame mCollectedCf = 0 + | otherwise = let + lastTxn = last $ view CF.cashflowTxn $ mCollectedCf + in + fromMaybe 0 (CF.tsCumDefaultBal lastTxn) - fromMaybe 0 (CF.tsCumRecoveriesBal lastTxn) - fromMaybe 0 (CF.tsCumLossBal lastTxn) + currentPerformingBal = case mStat of Nothing -> 0 Just stat -> Map.findWithDefault 0 RuntimeCurrentPoolBalance stat diff --git a/src/Stmt.hs b/src/Stmt.hs index 61094b87..fb334724 100644 --- a/src/Stmt.hs +++ b/src/Stmt.hs @@ -207,10 +207,10 @@ combineTxn (SupportTxn d1 b1 b0 i1 p1 c1 m1) (SupportTxn d2 b2 b02 i2 p2 c2 m2) = SupportTxn d1 b2 b02 (i1 + i2) (p1 + p2) (c1 + c2) (TxnComments [m1,m2]) -data FlowDirection = Inflow - | Outflow - | Interflow - | Noneflow +data FlowDirection = Inflow -- cash flow into the SPV + | Outflow -- cash flow out of the SPV + | Interflow -- cash flow within the SPV + | Noneflow -- no cash flow deriving (Eq,Show,Generic) getFlow :: TxnComment -> FlowDirection @@ -229,7 +229,7 @@ getFlow comment = SwapOutSettle _ -> Outflow PurchaseAsset _ _-> Outflow Transfer _ _ -> Interflow - TransferBy _ _ _ -> Interflow + TransferBy {} -> Interflow FundWith _ _ -> Inflow PoolInflow _ _ -> Inflow LiquidationProceeds _ -> Inflow diff --git a/src/Triggers.hs b/src/Triggers.hs index c4e70325..0fe70e6e 100644 --- a/src/Triggers.hs +++ b/src/Triggers.hs @@ -9,6 +9,7 @@ module Triggers( import qualified Data.Text as T import qualified Stmt as S +import qualified Liability as L import Text.Read (readMaybe) import Lib import Types @@ -37,6 +38,7 @@ data TriggerEffect = DealStatusTo DealStatus -- ^ chan (Maybe [CollectionRule]) -- ^ close the deal | BuyAsset AccountName PricingMethod -- ^ buy asset from the assumption using funds from account + | ChangeBondRate BondName L.InterestInfo IRate -- ^ change bond rate | TriggerEffects [TriggerEffect] -- ^ a combination of effects above | RunActions [Action] -- ^ run a list of waterfall actions | DoNothing -- ^ do nothing diff --git a/src/Types.hs b/src/Types.hs index 28bc2c8f..b7c6613b 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -32,7 +32,7 @@ module Types ,ActionWhen(..),DealStatFields(..) ,getDealStatType,getPriceValue,preHasTrigger ,MyRatio,HowToPay(..),BondPricingMethod(..),InvestorAction(..) - ,_BondTxn ,_InspectBal + ,_BondTxn ,_InspectBal, _IrrResult ) where @@ -250,6 +250,29 @@ data PoolId = PoolName String -- ^ pool name | DealBondFlow DealName String Date Rate -- ^ bond flow from deal deriving (Eq,Ord,Generic) +instance Show PoolId where + show (PoolName n) = n + show PoolConsol = "PoolConsol" + show (DealBondFlow dn bn sd r) = "BondFlow:"++dn++":"++bn++":"++show sd++":"++show r + +instance (Read PoolId) where + readsPrec d "PoolConsol" = [(PoolConsol,"")] + readsPrec d rStr = + let + pn = Data.List.Split.splitOn ":" rStr + in + case pn of + [dn,bn,sd,r] -> + let + sd' = TF.parseTimeOrError True TF.defaultTimeLocale "%Y-%m-%d" sd + r' = read r::Rate + in + [(DealBondFlow dn bn sd' r',"")] + ["PoolName",pn] -> [(PoolName pn,"")] + _ -> error $ "Invalid PoolId: "++ show pn + + + data Cmp = G -- ^ Greater than | GE -- ^ Greater Equal than @@ -286,6 +309,9 @@ data PoolSource = CollectedInterest -- ^ interest data TsPoint a = TsPoint Date a deriving (Show,Eq,Read,Generic) +instance Ord a => Ord (TsPoint a) where + compare (TsPoint d1 tv1) (TsPoint d2 tv2) = compare d1 d2 + data PerPoint a = PerPoint Int a deriving (Show,Eq,Read,Generic) @@ -461,7 +487,7 @@ data DealStatus = DealAccelerated (Maybe Date) -- ^ Deal is accelerated sta | PreClosing DealStatus -- ^ Deal is not closed, but has a closing date | Warehousing (Maybe DealStatus) -- ^ Deal is not closed, but closing date is not determined yet | Called -- ^ Deal is called - | Ended -- ^ Deal is marked as closed + | Ended Date -- ^ Deal is marked as closed deriving (Show,Ord,Eq,Read, Generic) -- ^ pricing methods for assets @@ -515,7 +541,6 @@ data Pre = IfZero DealStats deriving (Show,Generic,Eq,Ord,Read) - data Table a b = ThresholdTable [(a,b)] deriving (Show,Eq,Ord,Read,Generic) @@ -592,6 +617,7 @@ data DealStats = CurrentBondBalance | PoolCumCollectionTill Int [PoolSource] (Maybe [PoolId]) | PoolCurCollection [PoolSource] (Maybe [PoolId]) | PoolCollectionStats Int [PoolSource] (Maybe [PoolId]) + | PoolWaSpread (Maybe [PoolId]) | AllAccBalance | AccBalance [AccName] | LedgerBalance [String] @@ -754,6 +780,7 @@ data CashflowReport = CashflowReport { ,endDate :: Date } deriving (Show,Read,Generic,Eq) + data Threshold = Below | EqBelow | Above @@ -766,29 +793,32 @@ data SplitType = EqToLeft -- if equal, the element belongs to left | EqToLeftKeepOnes deriving (Show, Eq, Generic) -data CutoffFields = IssuanceBalance -- ^ pool issuance balance - | HistoryRecoveries -- ^ cumulative recoveries - | HistoryInterest -- ^ cumulative interest collected - | HistoryPrepayment -- ^ cumulative prepayment collected +-- ^ deal level cumulative statistics +data CutoffFields = IssuanceBalance -- ^ pool issuance balance + | HistoryRecoveries -- ^ cumulative recoveries + | HistoryInterest -- ^ cumulative interest collected + | HistoryPrepayment -- ^ cumulative prepayment collected | HistoryPrepaymentPentalty -- ^ cumulative prepayment collected - | HistoryPrincipal -- ^ cumulative principal collected - | HistoryRental -- ^ cumulative rental collected - | HistoryDefaults -- ^ cumulative default balance - | HistoryDelinquency -- ^ cumulative delinquency balance - | HistoryLoss -- ^ cumulative loss/write-off balance - | HistoryCash -- ^ cumulative cash + | HistoryPrincipal -- ^ cumulative principal collected + | HistoryRental -- ^ cumulative rental collected + | HistoryDefaults -- ^ cumulative default balance + | HistoryDelinquency -- ^ cumulative delinquency balance + | HistoryLoss -- ^ cumulative loss/write-off balance + | HistoryCash -- ^ cumulative cash | HistoryFeePaid - | AccruedInterest -- ^ accrued interest at closing - | RuntimeCurrentPoolBalance -- ^ current pool balance + | AccruedInterest -- ^ accrued interest at closing + | RuntimeCurrentPoolBalance -- ^ current pool balance deriving (Show,Ord,Eq,Read,Generic,NFData) data PriceResult = PriceResult Valuation PerFace WAL Duration Convexity AccruedInterest [Txn] - | AssetPrice Valuation WAL Duration Convexity AccruedInterest - | OASResult PriceResult [Valuation] Spread - | ZSpread Spread - | IrrResult IRR [Txn] - deriving (Show, Eq, Generic) + | AssetPrice Valuation WAL Duration Convexity AccruedInterest + | OASResult PriceResult [Valuation] Spread + | ZSpread Spread + | IrrResult IRR [Txn] + deriving (Show, Eq, Generic) + +makePrisms ''PriceResult getPriceValue :: PriceResult -> Balance getPriceValue (AssetPrice v _ _ _ _ ) = v @@ -873,31 +903,6 @@ data TimeHorizion = ByMonth instance TimeSeries (TsPoint a) where getDate (TsPoint d a) = d -instance Ord a => Ord (TsPoint a) where - compare (TsPoint d1 tv1) (TsPoint d2 tv2) = compare d1 d2 - -- compare (PoolPeriodPoint i1 tv1) (PoolPeriodPoint i2 tv2) = compare i1 i2 - -instance Show PoolId where - show (PoolName n) = n - show PoolConsol = "PoolConsol" - show (DealBondFlow dn bn sd r) = "BondFlow:"++dn++":"++bn++":"++show sd++":"++show r - -instance (Read PoolId) where - readsPrec d "PoolConsol" = [(PoolConsol,"")] - readsPrec d rStr = - let - pn = Data.List.Split.splitOn ":" rStr - in - case pn of - [dn,bn,sd,r] -> - let - sd' = TF.parseTimeOrError True TF.defaultTimeLocale "%Y-%m-%d" sd - r' = read r::Rate - in - [(DealBondFlow dn bn sd' r',"")] - ["PoolName",pn] -> [(PoolName pn,"")] - _ -> error $ "Invalid PoolId: "++ show pn - $(deriveJSON defaultOptions ''DecimalRaw) $(deriveJSON defaultOptions ''TsPoint) @@ -1086,6 +1091,7 @@ getDealStatType (Avg dss) = RtnRate getDealStatType (Divide ds1 ds2) = RtnRate getDealStatType (Multiply _) = RtnRate getDealStatType (Factor _ _) = RtnRate +getDealStatType (PoolWaSpread _) = RtnRate getDealStatType (CurrentPoolBorrowerNum _) = RtnInt getDealStatType (MonthsTillMaturity _) = RtnInt @@ -1138,13 +1144,9 @@ instance FromJSONKey DateType where $(deriveJSON defaultOptions ''RangeType) --- $(deriveJSON defaultOptions ''(PerCurve Balance)) --- $(deriveJSON defaultOptions ''(PerCurve Rate)) $(deriveJSON defaultOptions ''PerCurve) $(deriveJSON defaultOptions ''Pre) - $(deriveJSON defaultOptions ''CustomDataType) - $(deriveJSON defaultOptions ''ActionWhen) instance ToJSONKey ActionWhen where @@ -1209,4 +1211,4 @@ $(deriveJSON defaultOptions ''RateAssumption) $(deriveJSON defaultOptions ''Direction) makePrisms ''Txn -$(concat <$> traverse (deriveJSON defaultOptions) [''Limit] ) \ No newline at end of file +$(concat <$> traverse (deriveJSON defaultOptions) [''Limit] ) diff --git a/src/Waterfall.hs b/src/Waterfall.hs index 5d3eeeb8..555c190b 100644 --- a/src/Waterfall.hs +++ b/src/Waterfall.hs @@ -135,4 +135,4 @@ $(deriveJSON defaultOptions ''BookType) $(deriveJSON defaultOptions ''ExtraSupport) $(deriveJSON defaultOptions ''PayOrderBy) $(deriveJSON defaultOptions ''Action) -$(deriveJSON defaultOptions ''CollectionRule) \ No newline at end of file +$(deriveJSON defaultOptions ''CollectionRule) diff --git a/swagger.json b/swagger.json index cfe016a3..7a013f4f 100644 --- a/swagger.json +++ b/swagger.json @@ -2478,14 +2478,14 @@ { "properties": { "contents": { - "items": { - "$ref": "#/components/schemas/ObligorStrategy" + "additionalProperties": { + "$ref": "#/components/schemas/ApplyAssumptionType" }, - "type": "array" + "type": "object" }, "tag": { "enum": [ - "ByObligor" + "ByPoolId" ], "type": "string" } @@ -2494,20 +2494,20 @@ "tag", "contents" ], - "title": "ByObligor", + "title": "ByPoolId", "type": "object" }, { "properties": { "contents": { - "additionalProperties": { - "$ref": "#/components/schemas/ApplyAssumptionType" + "items": { + "$ref": "#/components/schemas/ObligorStrategy" }, - "type": "object" + "type": "array" }, "tag": { "enum": [ - "ByPoolId" + "ByObligor" ], "type": "string" } @@ -2516,7 +2516,7 @@ "tag", "contents" ], - "title": "ByPoolId", + "title": "ByObligor", "type": "object" }, { @@ -6052,6 +6052,28 @@ "title": "PoolCollectionStats", "type": "object" }, + { + "properties": { + "contents": { + "items": { + "$ref": "#/components/schemas/PoolId" + }, + "type": "array" + }, + "tag": { + "enum": [ + "PoolWaSpread" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "PoolWaSpread", + "type": "object" + }, { "properties": { "tag": { @@ -8994,6 +9016,9 @@ }, { "properties": { + "contents": { + "$ref": "#/components/schemas/Day" + }, "tag": { "enum": [ "Ended" @@ -9002,7 +9027,8 @@ } }, "required": [ - "tag" + "tag", + "contents" ], "title": "Ended", "type": "object" @@ -9172,7 +9198,7 @@ ], "type": "string" }, - "Either_[Char]_((CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))),(Maybe_[PriceResult]))": { + "Either_[Char]_(CashFlowFrame,(Maybe_[PriceResult]))": { "oneOf": [ { "properties": { @@ -9191,21 +9217,7 @@ "Right": { "items": [ { - "items": [ - { - "$ref": "#/components/schemas/CashFlowFrame" - }, - { - "additionalProperties": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "type": "object" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" + "$ref": "#/components/schemas/CashFlowFrame" }, { "items": { @@ -9227,7 +9239,7 @@ } ] }, - "Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))": { + "Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))": { "oneOf": [ { "properties": { @@ -9265,10 +9277,29 @@ "$ref": "#/components/schemas/PriceResult" }, "type": "object" + }, + { + "additionalProperties": { + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "type": "object" } ], - "maxItems": 4, - "minItems": 4, + "maxItems": 5, + "minItems": 5, "type": "array" } }, @@ -9280,7 +9311,7 @@ } ] }, - "Either_[Char]_(Map_PoolId_(CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))))": { + "Either_[Char]_(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame])))": { "oneOf": [ { "properties": { @@ -9303,11 +9334,10 @@ "$ref": "#/components/schemas/CashFlowFrame" }, { - "additionalProperties": { - "multipleOf": 1.0e-2, - "type": "number" + "items": { + "$ref": "#/components/schemas/CashFlowFrame" }, - "type": "object" + "type": "array" } ], "maxItems": 2, @@ -9382,6 +9412,13 @@ } ] }, + "ExpectReturn": { + "enum": [ + "DealLogs", + "AssetLevelFlow" + ], + "type": "string" + }, "ExtraStress": { "properties": { "defaultFactors": { @@ -10184,13 +10221,6 @@ "properties": { "contents": { "items": [ - { - "multipleOf": 1.0e-6, - "type": "number" - }, - { - "$ref": "#/components/schemas/Index" - }, { "multipleOf": 1.0e-6, "type": "number" @@ -10199,54 +10229,16 @@ "$ref": "#/components/schemas/DatePattern" }, { - "$ref": "#/components/schemas/DayCount" - }, - { - "multipleOf": 1.0e-6, - "type": "number" - }, - { - "multipleOf": 1.0e-6, - "type": "number" - } - ], - "maxItems": 7, - "minItems": 7, - "type": "array" - }, - "tag": { - "enum": [ - "Floater" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "Floater", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "multipleOf": 1.0e-6, - "type": "number" - }, - { - "$ref": "#/components/schemas/DayCount" + "$ref": "#/components/schemas/Day" } ], - "maxItems": 2, - "minItems": 2, + "maxItems": 3, + "minItems": 3, "type": "array" }, "tag": { "enum": [ - "Fix" + "BankAccount" ], "type": "string" } @@ -10255,7 +10247,7 @@ "tag", "contents" ], - "title": "Fix", + "title": "BankAccount", "type": "object" }, { @@ -10263,145 +10255,33 @@ "contents": { "items": [ { - "$ref": "#/components/schemas/DealStats" + "$ref": "#/components/schemas/Index" }, - { - "$ref": "#/components/schemas/InterestInfo" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "RefBal" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "RefBal", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ { "multipleOf": 1.0e-6, "type": "number" }, { - "$ref": "#/components/schemas/DealStats" - }, - { - "format": "float", - "type": "number" + "$ref": "#/components/schemas/DatePattern" }, { "$ref": "#/components/schemas/DatePattern" - } - ], - "maxItems": 4, - "minItems": 4, - "type": "array" - }, - "tag": { - "enum": [ - "RefRate" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "RefRate", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "$ref": "#/components/schemas/InterestInfo" }, { - "multipleOf": 1.0e-6, - "type": "number" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "CapRate" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "CapRate", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "$ref": "#/components/schemas/InterestInfo" + "$ref": "#/components/schemas/Day" }, { "multipleOf": 1.0e-6, "type": "number" } ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "FloorRate" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "FloorRate", - "type": "object" - }, - { - "properties": { - "contents": { - "items": [ - { - "$ref": "#/components/schemas/InterestInfo" - }, - { - "$ref": "#/components/schemas/InterestOverInterestType" - } - ], - "maxItems": 2, - "minItems": 2, + "maxItems": 6, + "minItems": 6, "type": "array" }, "tag": { "enum": [ - "WithIoI" + "InvestmentAccount" ], "type": "string" } @@ -10410,7 +10290,7 @@ "tag", "contents" ], - "title": "WithIoI", + "title": "InvestmentAccount", "type": "object" } ] @@ -10924,9 +10804,71 @@ ], "title": "StopByExtTimes", "type": "object" - } - ] - }, + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "EarlierOf" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "EarlierOf", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "maximum": 9223372036854775807, + "minimum": -9223372036854775808, + "type": "integer" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "LaterOf" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "LaterOf", + "type": "object" + } + ] + }, "LeaseRateCalc": { "oneOf": [ { @@ -11834,7 +11776,7 @@ "$ref": "#/components/schemas/RevolvingAssumption" }, "stopRunBy": { - "$ref": "#/components/schemas/Day" + "$ref": "#/components/schemas/StopBy" } }, "type": "object" @@ -12039,219 +11981,28 @@ ] }, "OriginalInfo": { - "oneOf": [ - { - "properties": { - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originRate": { - "$ref": "#/components/schemas/RateType" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "period": { - "$ref": "#/components/schemas/Period" - }, - "prepaymentPenalty": { - "$ref": "#/components/schemas/PrepayPenaltyType" - }, - "prinType": { - "$ref": "#/components/schemas/AmortPlan" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "MortgageOriginalInfo" - ], - "type": "string" - } - }, - "required": [ - "originBalance", - "originRate", - "originTerm", - "period", - "startDate", - "prinType", - "tag" - ], - "title": "MortgageOriginalInfo", - "type": "object" - }, - { - "properties": { - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originRate": { - "$ref": "#/components/schemas/RateType" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "period": { - "$ref": "#/components/schemas/Period" - }, - "prinType": { - "$ref": "#/components/schemas/AmortPlan" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "LoanOriginalInfo" - ], - "type": "string" - } - }, - "required": [ - "originBalance", - "originRate", - "originTerm", - "period", - "startDate", - "prinType", - "tag" - ], - "title": "LoanOriginalInfo", - "type": "object" + "properties": { + "maturityDate": { + "$ref": "#/components/schemas/Day" }, - { - "properties": { - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originRental": { - "$ref": "#/components/schemas/LeaseRateCalc" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "LeaseInfo" - ], - "type": "string" - } - }, - "required": [ - "startDate", - "originTerm", - "originRental", - "tag" - ], - "title": "LeaseInfo", - "type": "object" + "originBalance": { + "multipleOf": 1.0e-2, + "type": "number" }, - { - "properties": { - "accRule": { - "$ref": "#/components/schemas/AmortRule" - }, - "capacity": { - "$ref": "#/components/schemas/Capacity" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originTerm": { - "maximum": 9223372036854775807, - "minimum": -9223372036854775808, - "type": "integer" - }, - "period": { - "$ref": "#/components/schemas/Period" - }, - "residualBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "FixedAssetInfo" - ], - "type": "string" - } - }, - "required": [ - "startDate", - "originBalance", - "residualBalance", - "originTerm", - "period", - "accRule", - "capacity", - "tag" - ], - "title": "FixedAssetInfo", - "type": "object" + "originDate": { + "$ref": "#/components/schemas/Day" }, - { - "properties": { - "dueDate": { - "$ref": "#/components/schemas/Day" - }, - "feeType": { - "$ref": "#/components/schemas/ReceivableFeeType" - }, - "obligor": { - "$ref": "#/components/schemas/Obligor" - }, - "originAdvance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "originBalance": { - "multipleOf": 1.0e-2, - "type": "number" - }, - "startDate": { - "$ref": "#/components/schemas/Day" - }, - "tag": { - "enum": [ - "ReceivableInfo" - ], - "type": "string" - } - }, - "required": [ - "startDate", - "originBalance", - "originAdvance", - "dueDate", - "tag" - ], - "title": "ReceivableInfo", - "type": "object" + "originRate": { + "format": "double", + "type": "number" } - ] + }, + "required": [ + "originBalance", + "originDate", + "originRate" + ], + "type": "object" }, "PayOrderBy": { "oneOf": [ @@ -13141,10 +12892,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13175,10 +12952,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13209,12 +13012,38 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" - }, - "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" - }, - "issuanceStat": { + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "futureScheduleCf": { + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "issuanceStat": { "additionalProperties": { "multipleOf": 1.0e-2, "type": "number" @@ -13243,10 +13072,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13277,10 +13132,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13311,10 +13192,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13345,10 +13252,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -13379,10 +13312,36 @@ "$ref": "#/components/schemas/DatePattern" }, "futureCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "futureScheduleCf": { - "$ref": "#/components/schemas/CashFlowFrame" + "items": [ + { + "$ref": "#/components/schemas/CashFlowFrame" + }, + { + "items": { + "$ref": "#/components/schemas/CashFlowFrame" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" }, "issuanceStat": { "additionalProperties": { @@ -16348,7 +16307,372 @@ }, "tag": { "enum": [ - "AssetCurve" + "AssetCurve" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "AssetCurve", + "type": "object" + } + ] + }, + "RootFindReq": { + "oneOf": [ + { + "properties": { + "contents": { + "items": [ + { + "items": [ + { + "$ref": "#/components/schemas/DealType" + }, + { + "$ref": "#/components/schemas/ApplyAssumptionType" + }, + { + "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + } + ], + "maxItems": 4, + "minItems": 4, + "type": "array" + }, + { + "type": "string" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "FirstLossReq" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "FirstLossReq", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "items": [ + { + "$ref": "#/components/schemas/DealType" + }, + { + "$ref": "#/components/schemas/ApplyAssumptionType" + }, + { + "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + } + ], + "maxItems": 4, + "minItems": 4, + "type": "array" + }, + { + "type": "string" + }, + { + "type": "boolean" + }, + { + "type": "boolean" + } + ], + "maxItems": 4, + "minItems": 4, + "type": "array" + }, + "tag": { + "enum": [ + "MaxSpreadToFaceReq" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "MaxSpreadToFaceReq", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "items": [ + { + "$ref": "#/components/schemas/DealType" + }, + { + "$ref": "#/components/schemas/ApplyAssumptionType" + }, + { + "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + } + ], + "maxItems": 4, + "minItems": 4, + "type": "array" + }, + { + "$ref": "#/components/schemas/RootFindTweak" + }, + { + "$ref": "#/components/schemas/RootFindStop" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + "tag": { + "enum": [ + "RootFinderReq" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "RootFinderReq", + "type": "object" + } + ] + }, + "RootFindResp": { + "items": [ + { + "format": "double", + "type": "number" + }, + { + "items": [ + { + "$ref": "#/components/schemas/DealType" + }, + { + "$ref": "#/components/schemas/ApplyAssumptionType" + }, + { + "$ref": "#/components/schemas/NonPerfAssumption" + }, + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + } + ], + "maxItems": 4, + "minItems": 4, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "RootFindStop": { + "oneOf": [ + { + "properties": { + "contents": { + "type": "string" + }, + "tag": { + "enum": [ + "BondIncurLoss" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondIncurLoss", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BondIncurPrinLoss" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondIncurPrinLoss", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BondIncurIntLoss" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondIncurIntLoss", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "type": "boolean" + }, + { + "type": "boolean" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + "tag": { + "enum": [ + "BondPricingEqOriginBal" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondPricingEqOriginBal", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "multipleOf": 1.0e-6, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BondMetTargetIrr" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "BondMetTargetIrr", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/DealStats" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "BalanceFormula" ], "type": "string" } @@ -16357,35 +16681,24 @@ "tag", "contents" ], - "title": "AssetCurve", + "title": "BalanceFormula", "type": "object" } ] }, - "RootFindReq": { + "RootFindTweak": { "oneOf": [ { "properties": { "contents": { "items": [ { - "items": [ - { - "$ref": "#/components/schemas/DealType" - }, - { - "$ref": "#/components/schemas/ApplyAssumptionType" - }, - { - "$ref": "#/components/schemas/NonPerfAssumption" - } - ], - "maxItems": 3, - "minItems": 3, - "type": "array" + "format": "double", + "type": "number" }, { - "type": "string" + "format": "double", + "type": "number" } ], "maxItems": 2, @@ -16394,7 +16707,7 @@ }, "tag": { "enum": [ - "FirstLossReq" + "StressPoolDefault" ], "type": "string" } @@ -16403,7 +16716,7 @@ "tag", "contents" ], - "title": "FirstLossReq", + "title": "StressPoolDefault", "type": "object" }, { @@ -16411,38 +16724,21 @@ "contents": { "items": [ { - "items": [ - { - "$ref": "#/components/schemas/DealType" - }, - { - "$ref": "#/components/schemas/ApplyAssumptionType" - }, - { - "$ref": "#/components/schemas/NonPerfAssumption" - } - ], - "maxItems": 3, - "minItems": 3, - "type": "array" - }, - { - "type": "string" - }, - { - "type": "boolean" + "format": "double", + "type": "number" }, { - "type": "boolean" + "format": "double", + "type": "number" } ], - "maxItems": 4, - "minItems": 4, + "maxItems": 2, + "minItems": 2, "type": "array" }, "tag": { "enum": [ - "MaxSpreadToFaceReq" + "StressPoolPrepayment" ], "type": "string" } @@ -16451,35 +16747,39 @@ "tag", "contents" ], - "title": "MaxSpreadToFaceReq", + "title": "StressPoolPrepayment", "type": "object" - } - ] - }, - "RootFindResp": { - "oneOf": [ + }, { "properties": { "contents": { "items": [ { - "format": "double", - "type": "number" - }, - { - "$ref": "#/components/schemas/ApplyAssumptionType" + "type": "string" }, { - "$ref": "#/components/schemas/RevolvingAssumption" + "items": [ + { + "format": "double", + "type": "number" + }, + { + "format": "double", + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 2, + "minItems": 2, "type": "array" }, "tag": { "enum": [ - "FirstLossResult" + "MaxSpreadTo" ], "type": "string" } @@ -16488,7 +16788,7 @@ "tag", "contents" ], - "title": "FirstLossResult", + "title": "MaxSpreadTo", "type": "object" }, { @@ -16496,17 +16796,25 @@ "contents": { "items": [ { - "format": "double", - "type": "number" + "type": "string" }, { - "additionalProperties": { - "$ref": "#/components/schemas/Bond" - }, - "type": "object" + "type": "string" }, { - "$ref": "#/components/schemas/DealType" + "items": [ + { + "format": "double", + "type": "number" + }, + { + "format": "double", + "type": "number" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" } ], "maxItems": 3, @@ -16515,7 +16823,7 @@ }, "tag": { "enum": [ - "BestSpreadResult" + "SplitFixedBalance" ], "type": "string" } @@ -16524,7 +16832,7 @@ "tag", "contents" ], - "title": "BestSpreadResult", + "title": "SplitFixedBalance", "type": "object" } ] @@ -16667,6 +16975,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "$ref": "#/components/schemas/DealType" }, @@ -16677,8 +16991,8 @@ "$ref": "#/components/schemas/NonPerfAssumption" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16699,6 +17013,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "$ref": "#/components/schemas/DealType" }, @@ -16712,8 +17032,8 @@ "$ref": "#/components/schemas/NonPerfAssumption" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16734,6 +17054,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "additionalProperties": { "$ref": "#/components/schemas/DealType" @@ -16747,8 +17073,8 @@ "$ref": "#/components/schemas/NonPerfAssumption" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16769,6 +17095,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "$ref": "#/components/schemas/DealType" }, @@ -16782,8 +17114,8 @@ "type": "object" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16804,6 +17136,12 @@ "properties": { "contents": { "items": [ + { + "items": { + "$ref": "#/components/schemas/ExpectReturn" + }, + "type": "array" + }, { "additionalProperties": { "$ref": "#/components/schemas/DealType" @@ -16823,8 +17161,8 @@ "type": "object" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16849,6 +17187,9 @@ "properties": { "contents": { "items": [ + { + "type": "boolean" + }, { "$ref": "#/components/schemas/PoolTypeWrap" }, @@ -16862,8 +17203,8 @@ "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -16884,6 +17225,9 @@ "properties": { "contents": { "items": [ + { + "type": "boolean" + }, { "$ref": "#/components/schemas/PoolTypeWrap" }, @@ -16900,8 +17244,8 @@ "type": "array" } ], - "maxItems": 3, - "minItems": 3, + "maxItems": 4, + "minItems": 4, "type": "array" }, "tag": { @@ -17031,6 +17375,61 @@ } ] }, + "StopBy": { + "oneOf": [ + { + "properties": { + "contents": { + "$ref": "#/components/schemas/Day" + }, + "tag": { + "enum": [ + "StopByDate" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "StopByDate", + "type": "object" + }, + { + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/DatePattern" + }, + { + "items": { + "$ref": "#/components/schemas/Pre" + }, + "type": "array" + } + ], + "maxItems": 2, + "minItems": 2, + "type": "array" + }, + "tag": { + "enum": [ + "StopByPre" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "StopByPre", + "type": "object" + } + ] + }, "Table_(Fixed_*_E2)_(Fixed_*_E2)": { "items": { "items": [ @@ -18551,6 +18950,39 @@ "title": "BuyAsset", "type": "object" }, + { + "properties": { + "contents": { + "items": [ + { + "type": "string" + }, + { + "$ref": "#/components/schemas/InterestInfo" + }, + { + "multipleOf": 1.0e-6, + "type": "number" + } + ], + "maxItems": 3, + "minItems": 3, + "type": "array" + }, + "tag": { + "enum": [ + "ChangeBondRate" + ], + "type": "string" + } + }, + "required": [ + "tag", + "contents" + ], + "title": "ChangeBondRate", + "type": "object" + }, { "properties": { "contents": { @@ -20547,7 +20979,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20571,7 +21005,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20595,7 +21031,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20619,7 +21057,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20643,7 +21083,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20667,7 +21109,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20691,7 +21135,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20715,7 +21161,9 @@ } }, "required": [ - "deal" + "deal", + "futureCf", + "futureScheduleCf" ], "type": "object" }, @@ -20738,7 +21186,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.45.6" + "version": "0.46.4" }, "openapi": "3.0.0", "paths": { @@ -20758,7 +21206,7 @@ "content": { "application/json;charset=utf-8": { "schema": { - "$ref": "#/components/schemas/Either_[Char]_((CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))),(Maybe_[PriceResult]))" + "$ref": "#/components/schemas/Either_[Char]_(CashFlowFrame,(Maybe_[PriceResult]))" } } }, @@ -20787,7 +21235,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } @@ -20876,7 +21324,7 @@ "content": { "application/json;charset=utf-8": { "schema": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" } } }, @@ -20905,7 +21353,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } @@ -20936,7 +21384,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } @@ -20967,7 +21415,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(DealType,(Maybe_(Map_PoolId_CashFlowFrame)),(Maybe_[ResultComponent]),(Map_[Char]_PriceResult))" + "$ref": "#/components/schemas/Either_[Char]_(DealType,(Map_PoolId_CashFlowFrame),[ResultComponent],(Map_[Char]_PriceResult),(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame]))))" }, "type": "object" } @@ -20997,7 +21445,7 @@ "content": { "application/json;charset=utf-8": { "schema": { - "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))))" + "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame])))" } } }, @@ -21026,7 +21474,7 @@ "application/json;charset=utf-8": { "schema": { "additionalProperties": { - "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Map_CutoffFields_(Fixed_*_E2))))" + "$ref": "#/components/schemas/Either_[Char]_(Map_PoolId_(CashFlowFrame,(Maybe_[CashFlowFrame])))" }, "type": "object" } diff --git a/test/DealTest/DealTest.hs b/test/DealTest/DealTest.hs index 12e22fb4..7a7dfa0b 100644 --- a/test/DealTest/DealTest.hs +++ b/test/DealTest/DealTest.hs @@ -96,7 +96,7 @@ baseCase = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=Just (CF.CashFlowFrame dummySt []) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance, 4000)] ,P.extendPeriods = Nothing}))]) @@ -116,7 +116,7 @@ baseCase = D.TestDeal { baseTests = let nonRunAssump = (AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just [AP.InspectPt MonthEnd (FutureCurrentPoolBalance Nothing)]) Nothing Nothing Nothing Nothing Nothing Nothing) - (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase DealPoolFlowPricing Nothing nonRunAssump of + (dealAfterRun,poolCf,rcs,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Left e -> error $ "Deal run failed"++ show e Right x -> x inspects = [ rc | rc@(InspectBal {}) <- rcs ] diff --git a/test/DealTest/MultiPoolDealTest.hs b/test/DealTest/MultiPoolDealTest.hs index e33a5404..eea547ad 100644 --- a/test/DealTest/MultiPoolDealTest.hs +++ b/test/DealTest/MultiPoolDealTest.hs @@ -46,7 +46,7 @@ multiPool = Map.fromList [(PoolName "PoolA",P.Pool {P.assets=[AB.Mortgage ,(PoolName "PoolB",(P.Pool {P.assets=[AB.Mortgage AB.MortgageOriginalInfo{ AB.originBalance=4000 ,AB.originRate=Fix DC_ACT_365F 0.085 ,AB.originTerm=60 ,AB.period=Monthly ,AB.startDate=T.fromGregorian 2022 1 1 ,AB.prinType= AB.Level ,AB.prepaymentPenalty = Nothing} 3000 0.085 60 Nothing AB.Current] - ,P.futureCf=Just (CF.CashFlowFrame dummySt []) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,3000)] ,P.extendPeriods = Nothing}))] @@ -107,7 +107,7 @@ mPoolbaseTests = ,FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])] ] nonRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just inspectVars) Nothing Nothing Nothing Nothing Nothing Nothing - (dealAfterRun,poolCf,Just rcs,_) = case DR.runDeal baseCase DealPoolFlowPricing Nothing nonRunAssump of + (dealAfterRun,poolCf,rcs,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Right x -> x Left y -> error ("Error in running deal"++ show y) inspects = [ rc | rc@(InspectBal {}) <- rcs ] diff --git a/test/DealTest/ResecDealTest.hs b/test/DealTest/ResecDealTest.hs index 64d7963a..a3a8e604 100644 --- a/test/DealTest/ResecDealTest.hs +++ b/test/DealTest/ResecDealTest.hs @@ -78,7 +78,7 @@ baseCase = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=Just (CF.CashFlowFrame dummySt []) + ,P.futureCf=Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Nothing ,P.extendPeriods = Nothing}))]) @@ -121,7 +121,7 @@ resecDeal = D.TestDeal { ] ) ,D.pool = D.ResecDeal (Map.fromList [(DealBondFlow "base case" "A" (toDate "20200101") 0.25 - , D.UnderlyingDeal baseCase Nothing Nothing Nothing)]) + , D.UnderlyingDeal baseCase CF.emptyCashflow CF.emptyCashflow Nothing)]) ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [ (W.PayInt Nothing "General" ["A"] Nothing) ,(W.PayPrin Nothing "General" ["A"] Nothing) diff --git a/test/DealTest/RevolvingTest.hs b/test/DealTest/RevolvingTest.hs index 1dcde93e..a46c9b13 100644 --- a/test/DealTest/RevolvingTest.hs +++ b/test/DealTest/RevolvingTest.hs @@ -118,7 +118,7 @@ baseTests = ,FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])] ] nonRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing rAssump Nothing (Just inspectVars) Nothing Nothing Nothing Nothing Nothing Nothing - (dealAfterRun,poolCf,_,_) = case DR.runDeal baseCase DealPoolFlowPricing Nothing nonRunAssump of + (dealAfterRun,poolCf,_,_,_) = case DR.runDeal baseCase S.empty Nothing nonRunAssump of Right x -> x Left y -> error ("Error in running deal"++ show y) in diff --git a/test/UT/AccountTest.hs b/test/UT/AccountTest.hs index ceb1fef3..170744f6 100644 --- a/test/UT/AccountTest.hs +++ b/test/UT/AccountTest.hs @@ -87,7 +87,7 @@ reserveAccTest = ,CF.MortgageFlow (toDate "20220801") 110 20 10 0 0 0 0 0 Nothing Nothing Nothing ,CF.MortgageFlow (toDate "20220901") 90 20 10 0 0 0 0 0 Nothing Nothing Nothing ,CF.MortgageFlow (toDate "20221001") 70 20 10 0 0 0 0 0 Nothing Nothing Nothing] - ttd = set (dealPool . poolTypePool . (ix PoolConsol) . P.poolFutureCf) (Just testCFs) td2 {accounts = accMap} + ttd = set (dealPool . poolTypePool . (ix PoolConsol) . P.poolFutureCf) (Just (testCFs, Nothing)) td2 {accounts = accMap} in testGroup "Test On Reserve Acc" [ diff --git a/test/UT/AssetTest.hs b/test/UT/AssetTest.hs index a6d5aac5..7c08f88b 100644 --- a/test/UT/AssetTest.hs +++ b/test/UT/AssetTest.hs @@ -626,8 +626,8 @@ delinqScheduleCFTest = ,CF.MortgageDelinqFlow (L.toDate "20231001") 500 500 0 0 0 0 0 0 0.08 Nothing Nothing Nothing ] pool = P.Pool ([]::[AB.Mortgage]) - (Just (CF.CashFlowFrame dummySt cfs)) - (Just (CF.CashFlowFrame dummySt cfs)) + (Just (CF.CashFlowFrame dummySt cfs,Nothing)) + Nothing (L.toDate "20230801") Nothing (Just MonthEnd) @@ -642,8 +642,8 @@ delinqScheduleCFTest = poolCf = fst . head $ case D.runPool pool assump1 Nothing of - Left _ -> undefined - Right x -> x + Left errorMsg -> undefined `debug` ("Error in pool run"++show errorMsg) + Right x -> x `debug` ("pool run resp"++show x) poolCf2 = fst . head $ case D.runPool pool assump2 Nothing of Left _ -> undefined @@ -941,4 +941,4 @@ fixedAssetTest = -- in -- ((`CF.cfAt` 9) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") -- ((A.FixedAssetAssump utilCurve priceCurve Nothing) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing)))) - ] \ No newline at end of file + ] diff --git a/test/UT/BondTest.hs b/test/UT/BondTest.hs index e60fad4c..6b87cc7e 100644 --- a/test/UT/BondTest.hs +++ b/test/UT/BondTest.hs @@ -33,6 +33,7 @@ b1 = B.Bond{B.bndName="A" ,B.bndBalance=3000 ,B.bndRate=0.08 ,B.bndDuePrin=0.0 + ,B.bndStepUp = Nothing ,B.bndDueInt=0.0 ,B.bndDueIntOverInt=0.0 ,B.bndDueIntDate=Nothing @@ -50,6 +51,7 @@ bfloat = B.Bond{B.bndName="A" ,B.bndInterestInfo= B.Floater 0.02 LPR5Y 0.015 (MonthDayOfYear 1 1) DC_ACT_365F Nothing Nothing ,B.bndBalance=3000 ,B.bndRate=0.08 + ,B.bndStepUp = Nothing ,B.bndDuePrin=0.0 ,B.bndDueInt=0.0 ,B.bndDueIntDate=Nothing diff --git a/test/UT/CashflowTest.hs b/test/UT/CashflowTest.hs index c2603f52..619f788d 100644 --- a/test/UT/CashflowTest.hs +++ b/test/UT/CashflowTest.hs @@ -123,14 +123,6 @@ tsSplitTests = assertEqual "Keep previous one" ([],[cf1,cf2, cf3,cf4]) $ splitByDate ts1 (L.toDate "20230201") EqToLeftKeepOne - -- ,testCase "CashflowFrame" $ - -- assertEqual "Slice on Cashflow Frame" - -- (CF.CashFlowFrame [cf1,cf2],CF.CashFlowFrame [cf3,cf4]) $ - -- CF.splitCashFlowFrameByDate cff (L.toDate "20230215") EqToLeft - -- ,testCase "CashflowFrame" $ - -- assertEqual "Slice on Cashflow Frame" - -- (CF.CashFlowFrame [cf1,cf2,cf3],CF.CashFlowFrame [cf4]) $ - -- CF.splitCashFlowFrameByDate cff (L.toDate "20230301") EqToLeft ,testCase "Range of Ts" $ assertEqual "get subset of Ts between two dates" [cf2, cf3,cf4] $ diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs index 14627d60..2d61e9da 100644 --- a/test/UT/DealTest.hs +++ b/test/UT/DealTest.hs @@ -250,7 +250,7 @@ baseDeal = D.TestDeal { 60 Nothing AB.Current] - ,P.futureCf=Nothing + ,P.futureCf= Nothing ,P.extendPeriods = Nothing ,P.asOfDate = T.fromGregorian 2022 1 1 ,P.issuanceStat = Just $ Map.fromList [(RuntimeCurrentPoolBalance, 70),(IssuanceBalance, 4000)]})] @@ -269,22 +269,22 @@ baseDeal = D.TestDeal { poolFlowTest = let - (deal,mPoolCf,mResultComp,mPricing) = case (runDeal baseDeal DealPoolFlowPricing Nothing emptyRunAssump) of + (deal,mPoolCf,mResultComp,mPricing,oustandingFlow) = case (runDeal baseDeal S.empty Nothing emptyRunAssump) of (Left er) -> error $ "Deal run failed"++ show er - (Right (a,b,c,d)) -> (a,b,c,d) + (Right (a,b,c,d,e)) -> (a,b,c,d,e) bndMap = D.viewBondsInMap deal in testGroup "pool cashflow test" [ testCase "pool begin flow" $ assertEqual "pool size should be 60" - (Just (Map.fromList [(PoolConsol ,60)])) - ( (\m -> Map.map CF.sizeCashFlowFrame m) <$> mPoolCf ) -- `debug` ("pool "++ show (mPoolCf)) + (Map.fromList [(PoolConsol ,60)]) + (Map.map CF.sizeCashFlowFrame mPoolCf ) -- `debug` ("pool from test "++ show (mPoolCf)) ,testCase "total principal bal" $ assertEqual "pool bal should equal to total collect" - (Just (Map.fromList [(PoolConsol ,4000)])) - ((\m -> Map.map CF.totalPrincipal m) <$> mPoolCf ) -- `debug` ("pool "++ show (viewBond)) + (Map.fromList [(PoolConsol ,4000)]) + (Map.map CF.totalPrincipal mPoolCf) -- `debug` ("pool "++ show (viewBond)) ,testCase "last bond A payment date" $ assertEqual "pool bal should equal to total collect" @@ -305,7 +305,7 @@ queryTests = testGroup "deal stat query Tests" triggerTests = testGroup "Trigger Tests" [ let setup = 0 - poolflows = CF.CashFlowFrame dummySt $ + poolflows = (CF.CashFlowFrame dummySt $ [CF.MortgageDelinqFlow (toDate "20220201") 800 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ,CF.MortgageDelinqFlow (toDate "20220301") 700 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ,CF.MortgageDelinqFlow (toDate "20220401") 600 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing @@ -313,6 +313,7 @@ triggerTests = testGroup "Trigger Tests" ,CF.MortgageDelinqFlow (toDate "20220601") 400 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ,CF.MortgageDelinqFlow (toDate "20220701") 300 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing ] + ,Nothing) poolflowM = Map.fromList [(PoolConsol, poolflows)] ads = [PoolCollection (toDate "20220201") "" ,RunWaterfall (toDate "20220225") "" @@ -326,7 +327,7 @@ triggerTests = testGroup "Trigger Tests" ,RunWaterfall (toDate "20220625") "" ,PoolCollection (toDate "20220701")"" ,RunWaterfall (toDate "20220725") "" ] - (fdeal,_) = case run td2 poolflowM (Just ads) Nothing Nothing Nothing DL.empty of + (fdeal,_,_) = case run td2 poolflowM (Just ads) Nothing Nothing Nothing DL.empty of Left _ -> error "" Right x -> x in diff --git a/test/UT/DealTest2.hs b/test/UT/DealTest2.hs index 58b1aa37..ed1debf7 100644 --- a/test/UT/DealTest2.hs +++ b/test/UT/DealTest2.hs @@ -151,6 +151,7 @@ bondGroups = Map.fromList [("A" ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F ,L.bndBalance=1500 ,L.bndRate=0.08 + ,L.bndStepUp = Nothing ,L.bndDuePrin=0.0 ,L.bndDueInt=0.0 ,L.bndDueIntOverInt=0.0 @@ -171,6 +172,7 @@ bondGroups = Map.fromList [("A" ,L.bndRate=0.08 ,L.bndDuePrin=0.0 ,L.bndDueInt=0.0 + ,L.bndStepUp = Nothing ,L.bndDueIntOverInt=0.0 ,L.bndDueIntDate=Nothing ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1) @@ -182,6 +184,7 @@ bondGroups = Map.fromList [("A" ,L.Bond{ L.bndName="B" ,L.bndType=L.Equity + ,L.bndStepUp = Nothing ,L.bndOriginInfo= L.OriginalInfo{ L.originBalance=3000 ,L.originDate= (T.fromGregorian 2022 1 1)