diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,519 @@ +# Changelog for Hastructure + + + +## 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 + + +## 0.45.5 +### 2025-05-20 +* NEW: `MaxSpread` feature for structuring stage: get max possible bond coupon rate ! +* ENHANCE: Transfer from `stack` to `cabal` as build tool +* ENHANCE: Apply `DList` to trigger log +* ENHANCE: Enable `Double Decline Balance` in `FixedAsset` +* REFACTOR: Refactor `Leasing` asset type + * Add `Default` assumption + * Add `Period-based` rental ,in addition to `Day-based` rental calculation + + +## 0.45.2 +### 2025-04-01 +* ENHANCE: Performance optimization by replace `List` with `DList`. +* ENHANCE: In `inspection` ,expose `IsOutstanding` `HasPassedMaturity` in `Pre` + +## 0.45.1 +### 2025-03-25 +* FIX: in `Pricing/IRR`, error when holding position is too small +* ENHANCE: engine will auto patch `interest start date` for bonds if it is not modeled. In `PreClosing` status, engine will use `closing date` as bond interest begin date ; In `Non-PreClosing` status, it defaults to use last waterfall distribution date as bond interest begin date. + +## 0.45.0 +### 2025-03-21 +* BREAK: remove unused `DealDates` : `FixInterval`, `CustomDates` and `PatternInterval`. Since all these can be replace by new `GenericDates` in type `DateDesp` +* ENHANCE: now bond with `No last interest accure day` will begin accrue interest from `closing date` if the deal is in `PreClosing` mode, while the bond will use `last bond day` otherwise. +* FIX: `IsPaidOff` now can be queried in inspection formula + + +## 0.44.0 +### 2025-03-11 +* BREAK: Add `PAC` `PAC Anchor` to `BondGroup`, now `BondGroup` is `Map String L.Bond (Maybe PrinType)` +* NEW: add formula `bondTargetBalance` to query target amortized balance +* ENHANCE: expose `PAC Anchor` which is same to `PAC` except that the balance schedule will be ineffective if `Anchor Bonds` are paid off. + + +## 0.43.0 +### 2025-03-08 +* NEW: new interest type `BalRef` which bond will accrue its interest by a `Formula`, which is being used to model `IO` bond +* ENHANCE: in `FirstLoss` ,the stress will be applied to `revolving assumption` as well +* FIX: add `interest accrued` in bond pricing result +* BREAK: In waterfall ,the action `CalcBondInt` now only accepts a list of bond names +* BREAK: asset modeling and analytics `lease` has been refactored + + +## 0.42.10 +### 2025-02-15 +* NEW: expose new bond pricing : calculate IRR for `holding` a bond, `hold and sell` a bond, or `buy a bond`. +* ENHANCE: lift `Pricing` to expose error message. +* ENHANCE: change compare symbol in response from `GT` to `>` and others as well. +* ENHANCE: auto patch `bond paid periods` and `pool collection periods` for `preClosing` deal. + + +## 0.42.8 +### 2025-02-13 +* FIX: Enable `byTerm` assumption on `Installment` +* FIX: cap the default rate vector with 100% geneated by `root.finder` +* NEW: add `PeriodBased` rate curve or balance curve in `Pre`, i.e. easy to build default rate trigger in structuring stage + +## 0.42.4 +### 2025-02-06 +* NEW: `FirstLoss` as new endpoint, which will stress on `Default` assumption till 0.01 loss on input tranche. +* NEW: New prepayment /default assumption via `byTerm`, which vector curves are being applied via term of the assets. + + +## 0.42.3 +### 2025-02-04 +* NEW: `Multi-thread` on pool cashflow projection +* NEW: Expose `convexity` on bond/asset +* NEW: Add new prepayment assumption `PSA` for Monthly mortgage +* NEW: Add new prepayment/default vector assumption based on asset origin term + +## 0.42.1 +### 2025-02-02 +* NEW: add custom fee flow by `BondPaidPeriod` `PoolCollectedPeriod` index + + +## 0.42.0 +### 2025-02-01 +* ENHANCE: refactor `calcPmt` to boost 15x performance for mortgage cashflow projection. +* NEW: add `ScheduleByIndex` for bonds +* FIX: `fundWith` shall increase the bond balance +* ENHANCE: refactor Z-spread calc logic with numeric.root.finder + + +## 0.41.1 +### 2025-01-11 +* NEW: `Multi Interest Bond` which used to model in bond with `step up` feature ( sub ordinated interest) in European +* NEW: new assumption ,which used to funding existing bond. +* NEW: new query `totalFunding` for bond,which records all funding amount of bond. +* NEW: new query `AmountRequiredForIRR` for bond,which return the amount to be paid out make bond met the target IRR. +* NEW: in `Rate Swap` , the notional can be set by `Formula` +* ENHANCE: when account is being used as a source for `support`, it has option to book ledger with both `credit` and `debit` direction. +* FIX: `payPrinBySeq` was not paying out principal. + + +## 0.40.13 +### 2024-12-17 +* NEW: new formula `totalFunded` for bond with extra funding amount +* NEW: new deal run assumption `FundBond`, which records a time series funding amount for a single bond. +* ENHANCE: When booking account from `support` action, now user can book on `Credit` or `Debit` side +* FIX: `payPrinBySeq` was not working + + + +## 0.40.9 +### 2024-12-11 +* ENHANCE: Ensure `limit` always return positive ,otherwise engine will throw error +* NEW: add new action `changeStatus` in waterfall, with optional `Pre` as condition to trigger the status change + + +## 0.40.6 +### 2024-12-06 +* NEW: new formula `ledgerBalanceBy`, which return either `Credit` or `Debit` balance of a ledger +* FIX: step-up coupon bond which has a floater index will increase forever +* ENHANCE: refactor on `PDL` book type. + + +## 0.40.1 +### 2024-11-05 +* NEW: break changes on API ,now the engine is able to throw out error message instead of just hanging. + + +## 0.31.0 +### 2024-11-05 +* NEW: new Call options assumption ,which specifies `dates` to be tested +* ENHANCE: transform financial report to a `Tree` from a `Table` + +## 0.30.5 +### 2024-11-02 +* NEW: Expose bond factor formula for single bond +* FIX: Enable balanceSheet support for multiple pools +* FIX: Include logs from clean up waterfall +* FIX: Include logs from trigger/actions +* ENHANCE: query borrower number by Pool Id +* ENHANCE: query current pool balance by Pool Id + + +## 0.30.3 +### 2024-10-20 +* NEW: Expose combo sensitivity endpoint, +* NEW: Expose single clear ledger function +* NEW: Expose `writeoffBySeq` which write a list of bonds by sequence. +* NEW: Add new assumption curve with padding last value to rest +* NEW: Expose extra Stress on ppy/def curve, use can impose time-series based stress on prepayment and default. +* NEW: Expose `transferMultiple`, with one action transfer multiple account to single account +* ENHANCE: Expose pricing for bond groups +* ENHANCE: Instead of liquidating all pools but users now have the option to select pool to liquidate +* FIX: Revolve buy when building balance +* FIX: avoid duplicate run waterfall in call + + +## 0.28.21 +### 2024-8-25 +* ENHANCE: Expose pricing function with options of `include` or `not include` accrued interest. +* NEW: Ballon Mortgage +* NEW: Expose Assumption: defaultAtEnd with rates +* NEW: Expose revolving buy asset from multiple pools +* NEW: Expose which waterfall is run at each payment date + +## 0.28.16 +### 2024-8-6 +* FIX: correct `runPool` cashflow order and add UT + +## 0.28.15 +### 2024-7-31 +* FIX: enable compound formula on `weighted average` formula. + + +## 0.28.14 +### 2024-07-06 +* FIX: enable `annualized rate fee type` with formula `bondbalance` on `bondGroup` + +## 0.28.13 +### 2024-06-30 +* NEW: new assumption `issue bond` which allow funding by issuing new bonds during cashflow projection. +* NEW: new asset class `projectScheduleFlow` which can be divided projected cashflow with fix portion and float portions. The interest from the float portion will be affected by interest rate assumption. +* ENHANCE: enable formula `bondRate`/`bondWaRate` on `bondGroup` +* FIX: `formula` will return `inf` if a `divide` with zero instead of just throw exception +* FIX: `financial reports` was failing because it can't access to `interest due` on bond group. +* FIX: enable formula query on `bond groups` + + +## 0.28.8 +### 2024-06 +* FIX: `limit` on `payFee` was not working with `duePct` +* ENHANCE: expose `transaction statement` for `triggers` + +## 0.28.2 +### 2024-05-27 +* NEW: enable `trigger` to run waterfall `actions` +* FIX: the `result log` used to be doubled each pool collection period +* FIX: `payPrinResidual` will use all cash from account regardless principal due of bonds, which may caused negative balance of bonds( cash of account > principal due of bond) + +## 0.28.1 +### 2024-05-26 +* BREAK : add `bondGroup`, which group bonds and pay with prorata/sequential/by coupon rate/by maturity/by start date +* BREAK : add `begin balance`/`accure interest`/`as of date` for cashflow frame +* BREAK : add `interest arrears` `interest over interest` on bond cashflow +* NEW: add `interest over interest` settings on bonds and expose `interest over interest` `interest due` flow +* ENHANCE: add tabular representation of cashflow frame +* FIX: fix rolling default rate query + + +## 0.27.21 +### 2024-05-15 +* NEW: add `weekday ` in the date pattern +* ENHANCE: expose `weekly` /`biweekly` in `Period` +* NEW: now allow new `first N period without Fee` feature to model cashflow of type `Installment` +* FIX: negative pool balance for (revolving pool asset >= 2) + +## 0.27.13 +### 2024-05-05 +* ENHANCE: enable all `Combination Type` formula (via patching dates) +* ENHANCE: add capability to query txn in (Fee/Bond/Account) via a `comment` + + +## 0.27.12 +### 2024-05-04 +* ENHANCE: deal will return how it was ended in projection + +## 0.27.11 +### 2024-05-04 +* NEW: Formula: `originalBondBalance`,`BondDuePrin` +* NEW: Waterfall Action: `CalcBondPrin`,`PayPrinWithDue` +* ENHANCE: fix Formula: `PoolFactor` +* NEW: Enable `*` between formulas +* FIX: Unlimit Liquidity Provider has wrong available balance + +## 0.27.7 +### 2024-05-01 +* ENHANCE: Enable pricing on asset via a constant rate/rate curve; add `duration` for asset pricing (curve only) + + +## 0.27.4 +### 2024-04-15 +* ENHANCE: Pool run: enhance multip-scenario run and mulitple-assets type run +* ENHANCE: Enable revovling on `Receivable` +* ENHANCE: add `RecoveryByDays` to `Receivable` ,which describes recovery cash received after default. +* FIX: Fix single asset run on `lease` +* FIX: Failed to include cumulative stats on revolving buy assets +* FIX: Multi-asset run was failure due to including schedule cashflow run. +* ENHANCE: upgrade stack resolver from `lts-18.22` to `lts-22.6` + + +## 0.27.0 +### 2024-04-01 +* NEW: Now docker image ship with `Apple silicon` chip ! Happy hacking Mac users ! + + +## 0.26.2 +### 2024-03-24 +* FIX: patch recoveries for `Mortgage` type cashflow +* NEW: add new asset class `Receivable` which represent a `invoice factored`,`trading receivable` +* NEW: `DefaultAtEnd` assumption, which assumes asset default at last payment(For `Receivable`) + +## 0.26.1 +### 2024-03-09 +* NEW: `fundWith` which will increate the balance of bond and deposit cash to account. +* NEW: `writeOff` which will write off balance of bond via a formula +* NEW: a new predicate `passMaturity` which True if bonds has passed their expected maturity/pay off date. +* NEW: `Not` as composite boolean test. +* NEW: add new `OAS` pricing assumption, which return OAS spread given input scenarios. + +## 0.26.0 +### 2024-02-27 +* NEW: add `NO_FirstN` as type of `Mortgage` which implies no payment for first N period and interest due will be capitalized. +* NEW: add `IO_FirstN` as type of `Mortgage` which implies no principal payment for first N period. +* NEW: add `Make Whole` Feature, which allow user to set a ,, Table. The bond will be componsate with PV from spread determined by WAL remaining. + +## 0.25.0 +### 2024-02-16 +* NEW: add `resec deal`, which allow to use bonds as underlying assets and allow user to set assumption on underlying deals. + + +## 0.24.1 +### 2023-12-17 +* NEW: add `payIntBySeq` which pay interest to bonds sequentially with optional limit +* NEW: add condition to "ExtraSupport" ,which support only available if a is satisfied +* NEW: add `Nothing` to trigger effects +* NEW: add `payFeeBySeq` to which pay a list of fees sequentially with optional limit +* NEW: add a fee type which due amount is X per pool collection period +* NEW: add a fee type which is a lookup table with look up value from a formula +* NEW: add override feature `rate` and `balance` to `calcDueInt` action in waterfall. +* NEW: multiple pool support !! now engine support multiple pools in a deal with mixed assets. +* NEW: add query on `present value on schedule pool cashflow`, which enable `Yield Maitenance Overcollaterisaztion` supports + + + +## 0.23.1 +### 2023-11-16 +* NEW: new asset class `FixAsset` type , which yield cashflow given a `capacity` and assumption called `utilization rate curve`. The new asset type is applicable to Hotel booking/EV Charge station/Solar Panel/Wind Power type. +* NEW: new rate hedge instrument `RateCap` which yield cash if `rateCurve` is higher than a `strike rate` +* NEW: add `accruedInterest` field in pool stats, which will be deducted from pool cash flow +* NEW: add `payPrinBySeq` in waterfall action, now user can pay prin bond via a simple list. +* NEW: add an assumption `fireTrigger` which mannualy fire a trigger at point of projection +* NEW: add pool collection type `totalCash` will aggregate all pool cash field +* NEW: `payInt` now accept a `limit` which constrain how much interset to be paid via a `formula` +* NEW: add `bookBy` a ledger via `formula` +* NEW: add `I_P` to `Mortgage` type ,which models `Buy To Let` type mortgage( interest only and principal at last period) +* ENHANCE: include `Lens` and code clean up +* BREAK: refactor `StepUp` out of `interest` part of bond. + + +## 0.22.2 +### 2023-10-27 +* ENHANCE: expose cumulative stats on pool cashflow returned by `runDeal` + + +## 0.22.1 +### 2023-10-26 +* NEW: add `default by amount` assumption, which enable user to set a `total amount of default` alongside with a vector. +* ENHANCE: misc refactors + + +## 0.22.0 +### 2023-10-15 +* BREAK: cashflow now with `Cumulative Stats` ( cumulative default/delinq/loss/prepayment/principal/recovery) +* NEW: expose `inspect` in waterfall action to observe variables during a waterfall execution +* NEW: `stepup` now accpet a `pre` instead of a `date` to switch rate +* ENHANCE: auto patch `issuance balance` for `PreClosing` Deal +* ENHANCE: implement `pre-run check` and `post-run check` + * IssuanceBalance check : `Ongoing Deal` shall have a IssuanceBalance value in Pool + * Interest Rate check : index required by deal should be found in assumption + * Waterfall action check : actions in waterfall ( source/target) should exist in deal object +* FIX: fix bug on `prepay penalty` when using `stepDown` +* FIX: fix project cashflow for `Loan` + +## 0.21.5 +### 2023-10-8 +* ENHANCE: in the revolving buy , now buy amount is no longer a multipler of revolving assets face value +* FIX: now revolving asset may have remtain term == original term + +## 0.21.4 +### 2023-9-27 +* ENHANCE: require a new status when defining a deal in `preClosing` stage +* FIX: fix a bug when reading financial report logs + +## 0.21.3 +### 2023-9-26 +* NEW: include a `default`/`delinq`/`loss` status map when projecting cashflow +* NEW: implement `haircut` as extra stress projecting `mortgage` +* ENHANCE: include `called` deal status, which will be set when deal was triggered with a clean up call assumption +* ENHANCE: expose `runAsset` endpoint +* ENHANCE: expose formula query on `deal status` as well as `trigger status` +* ENHANCE: add `rampUp` deal status +* FIX: adjust bond reset date from `cutoff date` to `closing date` + +## 0.21.1 +### 2023-9-21 +* BREAK: seperate `performance assumption` +* BREAK: add `delinquency` projection on mortgage as well as schedule mortgage cashflow + +## 0.20.3 +### 2023-9-4 +* ENHANCE: now user can include boolean/int/balance/rate type query in `inspect` field + +## 0.20.2 +### 2023-8-31 +* BREAK: move `Trigger` from `list` into a `map` with a name +* ENHANCE: add `CumulatiePoolDefaultedRateTill` to query default rate as of collection period N , then support query last one,last two default rates in the past as a rolling basis.. +* ENHANCE: add `queryBool` with test logic of `any` `or` which will test all predicates or any predicates are/is satisfied. With new included aforementioned formula above, the engine can have a predicate like `last 2 period cumulative defaulte rates are all lower than 5%`, `any last 2 period cumulative defaulte rates is higher than 5%` + +## 0.20.1 +### 2023-8-29 +* ENHANCE: add `LedgerTxnAmt` , allow user to query transaction amount for a ledger by `comment` +* ENHANCE: expose `Abs` in formula , which will get absolute value of another formula + +## 0.20.0 +### 2023-8-25 +* BREAK: refactor `payInt` and `payFee` which includes `extraSupport` from either another `account` or `liquidation provider`, with option to book `PDL draw` on ledger +* NEW: expose `Cumulative Net Loss` `Cumulative Net Loss Ratio` `Bond Rate` `Bond Weight Average Rate` in formula +* NEW: expose `Avg` in formula ,which can calculate average value from a list of deal stats. +* NEW: expose `RefRate` in bond , now bond can be setup interest rate which reference to a value of deal , could be like 100% of Pool WAC coupon , or average of bond rate of bonds etc. +* ENHANCE: add `liquidity provider` `interest swap` to `balance sheet repot` +* ENHANCE: add new bool query `is_most_senior_bond` +* ENHANCE: add new balance query `PoolCurCollection` returns target pool source balance in last collected period +* ENHANCE: refactor account transfer by `target reserve amount` + + +## 0.19.15 +### 2023-8-20 +* ENHANCE: add `reserve account excess/gap` to formula +* ENHANCE: refactor bond `step up` coupon by date ,which pertains to Euro deals +* ENHANCE: add comments to souce code and prepare to release to `Hackage` + +## 0.19.12 +### 2023-8-17 +* NEW: Add `Step Up By Date` /`Cap`/`Floor` coupon type for bond +* NEW: Add `Prepay Penalty` attribute on `Mortgage`, penalty types includes: + * `rate0` before `term N` and `rate1` after `term N` + * Fixed amount in lifetime or before `term N` + * Fixed pct in life time or bfore `term N` + * Sliding from `rate0` by step of `rate1` + * Ladder type like first `12` periods with Pct of `Rate0` , next `12` periods with Pct of `Rate1` +* ENHANCE: refactor `liquidity provider` + * include a maybe `valid date` of the agreement + * include floater index + +## 0.19.11 +### 2023-8-14 +* ENHANCE: add `calcAndPay` action for fee +* ENHANCE: expose new assumption on expense projection +* ENHANCE: include a new `NO_IE` type to generate dates vector +* FIX: Fix missing periods of `recurr` type of fee + +## 0.19.10 +### 2023-8-7 +* NEW : add a new expense type: `TargetBalanceFee`, which due amount = ` - ` +* ENHANCE: add query total txn amount for account/bond/expense with optional `comment` as a filter +* ENHANCE: expoese query on `cumulative pool` on `recoveries` `principal` `interest` `prepayment` +* ENHANCE: expoese query on `beg balance` on pool + + +## 0.19.8 +### 2023-7-24 +* ENHANCE: trancate payments records for bond with 0 balance and 0 due interest/due pricipal + +## 0.19.7 +### 2023-7-19 +* ENHANCE: expose query on `cumulative pool recoveries` +* ENHANCE: expose `factor` in query +* ENHANCE: ensure principal payment is cap via bond oustanding balance + +## 0.19.6 +### 2023-7-18 +* FIX: update PDL Ledger balance after `bookBy` action + +## 0.19.4 +#### 2023-7-17 +* FIX: fix pricing error if bond flow size is 0 + +## 0.19.0 +#### 2023-7-1 +* BREAK : seperate `payInt` action and `accrueInt` action +* ENHANCE: optimize `Z-spread` calculation +* ENHANCE: re arrange `deal.hs` , break down code logic into seperate files. +* NEW: include `ledgers` to accomodate `PDL` feature (Principal Deficiency Ledger) +* ENHANCE: expose `rounding` on `deal stats`, which rounds interest rate change by a factor of fix amount ,or pay principal on balance by a factor of fix amount. +* ENAHNCE: expose `runDate` endpoint as sandbox for user to play with `` + + +## 0.18.9 +#### 2023-6-23 +* NEW : add `floorAndCap` formula to set upper or lower bound of formula value +* NEW : add formula based fee rate for `pct` and `annual` type of fee + +## 0.18.1 +#### 2023-6-21 +* NEW : Project cashflow for a list of asset, with performance assumption +* ENHANCE : Add `limit` for revolving buy action +* ENHANCE : Add `default` waterfall +* NEW : Add "IF-ELSE" in waterfall action + +## 0.18.0 +#### 2023-6-8 +* NEW "Major" : expose revolving assumption ! +* NEW : `Pre` now support comparing with a `balance` type formula ,not limited to a balance number + + +## 0.17.2 +#### 2023-5-24 +* NEW: expose `exclude dates` and `offset by days` + + +## 0.17.1 +#### 2023-5-21 +* NEW: expose trigger status in `Inspect` + +## 0.17.0 +#### 2023-5-21 +* NEW: expose `BalanceSheet Report` and `Cashflow Report`, user can query them via set flags in assumption +* BREAK: normalized some account comments to be analysed when compling `Cashflow Report` + + +## 0.16.0 +#### 2023-5-13 +* NEW: expose bond with `Step-Up coupon` feature +* BREAK:using `DatePattern` to annotate reset date for floater bonds +* FIX: data query in the trigger + +## 0.15.4 +#### 2023-5-6 +* FIX: Fix cashflow projection logic for `Installment` +* Include `DefaultedRecovery` assumption for defaulted assets. + +## 0.15 +#### 2023-5-1 +* Introduce new asset : `AdjustRateMortgage` with assumption: + * init period,first reset cap, periodic reset cap,lifetime cap, lifetime floor +* Docker hub will host each stable releases of Hastructure + + + diff --git a/Hastructure.cabal b/Hastructure.cabal new file mode 100644 --- /dev/null +++ b/Hastructure.cabal @@ -0,0 +1,264 @@ +cabal-version: 3.0 + +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack + +name: Hastructure +version: 0.45.0 +synopsis: Cashflow modeling library for structured finance +description: Please see the README on GitHub at +category: StructuredFinance;Securitisation;Cashflow +homepage: https://github.com/yellowbean/Hastructure#readme +bug-reports: https://github.com/yellowbean/Hastructure/issues +author: Xiaoyu +maintainer: always.zhang@gmail.com +copyright: 2025 Xiaoyu, Zhang +license: BSD-3-Clause +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 + +library + exposed-modules: + Accounts + Analytics + Asset + AssetClass.AssetBase + AssetClass.AssetCashflow + AssetClass.FixedAsset + AssetClass.Installment + AssetClass.Lease + AssetClass.Loan + AssetClass.MixedAsset + AssetClass.Mortgage + AssetClass.ProjectedCashFlow + AssetClass.Receivable + Assumptions + Call + Cashflow + CreditEnhancement + DateUtil + Deal + Deal.DealAction + Deal.DealBase + Deal.DealDate + Deal.DealMod + Deal.DealQuery + Deal.DealValidation + Errors + Expense + Hedge + InterestRate + Ledger + Liability + Lib + Pool + Reports + Revolving + Stmt + Triggers + Types + Util + Validation + Waterfall + other-modules: + Paths_Hastructure + autogen-modules: + Paths_Hastructure + hs-source-dirs: + src + build-depends: + Decimal >= 0.5.2 && < 0.6, + base >= 4.19.2 && < 4.20, + deepseq >= 1.5.1 && < 1.6, + MissingH >= 1.6.0 && < 1.7, + containers >= 0.6.8 && < 0.7, + template-haskell >= 2.21.0 && < 2.22, + 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.14.1 && < 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, + 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.3 && < 0.21, + servant-openapi3 >= 2.0.1 && < 2.1, + servant-server >= 0.20.3 && < 0.21, + wai >= 3.2.4 && < 3.3, + warp >= 3.4.8 && < 3.5, + split >= 0.2.5 && < 0.3, + string-conversions >= 0.4.0 && < 0.5, + swagger2 >= 2.8.10 && < 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 + main-is: Main.hs + other-modules: + MainBase + Paths_Hastructure + autogen-modules: + Paths_Hastructure + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + Decimal, + base >= 4.19.2 && < 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, + ieee754, + lens, + parallel, + math-functions, + monad-loops, + numeric-limits, + openapi3, + regex-pcre-builtin, + regex-tdfa, + 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 + DealTest.ResecDealTest + DealTest.RevolvingTest + UT.AccountTest + UT.AnalyticsTest + UT.AssetTest + UT.BondTest + UT.CashflowTest + UT.CeTest + UT.DealTest + UT.DealTest2 + UT.ExpTest + UT.InterestRateTest + UT.LibTest + UT.QueryTest + UT.RateHedgeTest + UT.StmtTest + UT.UtilTest + Paths_Hastructure + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + Hastructure, + Decimal, + base >= 4.19.2 && < 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, + ieee754, + lens, + parallel, + math-functions, + monad-loops, + numeric-limits, + openapi3, + regex-pcre-builtin, + regex-tdfa, + 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/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Xiaoyu Zhang (always.zhang A_T gmail ) (c) 2022-2025 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,96 @@ +[![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) + + +# What is Hastructure ? + +``Hastructure`` names after ``Haskell`` and ``Structured Finance``, aims to provide cashflow projection for deal/transactions described in either Haskell structure or ``JSON`` via RESTful Service, with inputs from below: + +* deal components (bonds,assets,accounts,waterfall,trigger,fees etc.) +* pool performance assumption input as well as interest rate assumption + +``Hastructure`` will generate outputs: + +* cashflow of bonds/accounts/fees +* pricing of bonds +* or other outputs make your lose money faster :sunglasses: + +# Why Hastructure ? + +* :bricks: A collection of building blocks to build cashflows model for structured product. User just need to `compose` them together. +* :car: In-house and white-label friendly. +* :flags: No lock-in risk, all JSONs input/output, no proprietary file formats. + +# I'm using language XXX + +* :snake: [Python wrapper](https://github.com/yellowbean/PyABS) is in ``Beta`` now ! +* :coffee: Easy integration with ``Java/C#/C++/JavaScript/Python`` with ``RESTful`` interface and Docker image are ready. + * C/Java : [here](https://github.com/yellowbean/Hastructure/issues/106) + +### Documentation + +* see what `Hastructure` is capable of -> [Here](https://absbox-doc.readthedocs.io/en/latest/) + * [Where is `Hastructure` doc ? ](https://github.com/yellowbean/Hastructure/wiki/Where-is-documentation-of-Hastructure-%3F) + +### Features +* Integration + * Built-in REST API services + * Language independent, integration friendly. + * Swagger -> [here](https://github.com/yellowbean/Hastructure/blob/master/swagger.json) + * Public server status -> [here](https://absbox.org) + * Docker Support +* Asset class coverage (Mortgage/Student Loan/Auto Loan/Rentals/Corp Loan/Consumer Installment) +* Pool Assumptions + * Mortgage (Prepay, Prepay Penalty, Deliquency, Default,Recovery Lag/Rate) + * Installment (Prepay Default Recovery Lag/Rate) + * Corp Loan (Prepay Default Recovery Lag/Rate) + * Receivable (Default Recovery Lag/Rate) + * Rentals (Gaps between leases,Rental Curve Assumption) + * Fixed Asset ( Uitility Rate) +* Multiple Waterfalls + * Clean up waterfall/ Pre,Post Enforcement waterfall + * Pool collection waterfall +* Accounts + * Reserve Account/Bank Account (with interest)/Cash Account/ Ledger(PDL) +* Bonds/Tranches + * Float Index rate / Step Up coupon type / Fix Rate + * Sequential / Prepay Lockout /PAC Bond Support /Z Bond Support + * Bond Pricing (IRR /WAL /Duration /Accrual Int) +* Call + * call by Pool/Bond Balance amount;Bond/Pool Factor;On Date/or after +* Fees + * Pool / Bond balanced based fees + * Fix Amount Fees / Custom Fee Flow / Number Type Fee of a deal / Formula based fee rate +* Liquidity Provider + * line of credit/ Unlimit support + * interest charge or fee charge on the credit used & unused +* Trigger + * Base on Date + * Base on Free Formula, Bond /Pool metrics + * Base on Pool performance, like Cumulative Default Rate, last 3 periods delinquency rates. + * Base on any combination above +* Interest Swap + * Float to Float/ Fix to Float + * formula based notional balance +* Scenario Analysis + * Running multiple scenarios on single deal + * Pricing on single asset + * Revoving Buy Analysis +* Free Formula Support + * User is able to using statistics of deal ( Pool Balance,Account balance ,total Bond Balance of , A factor of .. ) to construct formula which used to specify the amount of cash to transfer , pay out to fee or liabilities etc. +* Misc + * Support user define pay dates & pool collection dates + + +### Online Demo + +The demo only cover very limit features of this engine and subject to UI performance issue due to rapid prototype design of web component + +**Pls noted that the web demo is far behind latest development/stable version** + +* [Here](https://deal-bench.xyz) + + +### Others +* [Why yet another cashflow engine](https://github.com/yellowbean/Hastructure/wiki/Why-Yet-Anohter-Cashflow-Engine) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,513 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Main + where + +import Prelude () +import Prelude.Compat +import System.Environment +import Control.Monad.Catch (MonadCatch, MonadThrow (..)) +import Control.Monad.IO.Class (liftIO) +import Control.Monad (mapM) +import Control.Exception (Exception,throwIO,throw) +import Control.Monad.Except +import Control.Monad.Reader +import Data.Aeson +import Data.Aeson.Types +import Data.Aeson.TH +import Data.Aeson.Encode.Pretty (encodePretty) +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 +import Data.OpenApi hiding (Server,contentType) +import qualified Data.Map as Map +import Data.String.Conversions +import Data.Time.Calendar +import GHC.Generics +import GHC.Real +import qualified Data.ByteString.Lazy.Char8 as BL8 +import qualified Data.ByteString.Char8 as BS +import Network.Wai +import Network.Wai.Handler.Warp +import Network.Wai.Middleware.Cors +import qualified Data.Aeson.Parser +import Language.Haskell.TH +import Network.HTTP.Types.Status +import Servant.OpenApi +import Servant +import Servant.Types.SourceT (source) +import Servant.API.ContentTypes (contentType) + +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 +import qualified Pool as P +import qualified Expense as F +import qualified Ledger as LD +import qualified AssetClass.Installment +import qualified AssetClass.Mortgage +import qualified AssetClass.Loan +import qualified AssetClass.Lease +import qualified AssetClass.ProjectedCashFlow +import qualified AssetClass.MixedAsset as MA +import qualified AssetClass.AssetBase as AB +import qualified Assumptions as AP +import qualified Cashflow as CF +import qualified Accounts as A +import qualified Revolving +import qualified Liability as L +import qualified Call as C +import qualified CreditEnhancement as CE +import qualified Hedge as HE +import qualified Waterfall as W +import qualified InterestRate as IR +import qualified Stmt +import qualified Triggers as TRG +import qualified Revolving as RV +import qualified Lib +import qualified Util as U +import qualified DateUtil as DU +import Data.Scientific (fromRationalRepetend,formatScientific, Scientific,FPFormat(Fixed)) +import Control.Lens +import qualified Types as W +import Cashflow (patchCumulative) + +import Numeric.RootFinding + +import Debug.Trace +debug = flip Debug.Trace.trace + + +version1 :: Version +version1 = Version "0.46.4" + + +wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp +wrapRun fs (MDeal d) mAssump mNonPerfAssump + = do + (_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,_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,_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, _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, _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, _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, _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, _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 + +patchCumulativeToPoolRun :: RunPoolTypeRtn_ -> RunPoolTypeRtn_ +patchCumulativeToPoolRun + = Map.map + (\(CF.CashFlowFrame _ txns,mAssetFlow) -> + (CF.CashFlowFrame (0,Lib.toDate "19000101",Nothing) (CF.patchCumulative (0,0,0,0,0,0) [] txns),mAssetFlow)) + +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 (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 (fst (P.aggPool Nothing [(cf,Map.empty) | (cf,_) <- cfs]) , Nothing) +wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates (Just pm)) + = 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 + return (assetCf , Just pricingResult) + +-- Swagger API +type SwaggerAPI = "swagger.json" :> Get '[JSON] OpenApi +type EngineAPI = "version" :> Get '[JSON] Version + :<|> "runAsset" :> ReqBody '[JSON] RunAssetReq :> Post '[JSON] RunAssetResp + :<|> "runPool" :> ReqBody '[JSON] RunPoolReq :> Post '[JSON] PoolRunResp + :<|> "runPoolByScenarios" :> ReqBody '[JSON] RunPoolReq :> Post '[JSON] (Map.Map ScenarioName PoolRunResp) + :<|> "runDeal" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] RunResp + :<|> "runDealByScenarios" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map ScenarioName RunResp) + :<|> "runMultiDeals" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map ScenarioName RunResp) + :<|> "runDealByRunScenarios" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map ScenarioName RunResp) + :<|> "runByCombo" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map String RunResp) + :<|> "runByRootFinder" :> ReqBody '[JSON] RootFindReq :> Post '[JSON] (Either String RootFindResp) + :<|> "runDate" :> ReqBody '[JSON] RunDateReq :> Post '[JSON] [Date] + +engineAPI :: Proxy EngineAPI +engineAPI = Proxy + +type API = SwaggerAPI :<|> EngineAPI + +engineSwagger:: OpenApi +engineSwagger = toOpenApi engineAPI + & info.title .~ "Hastructure API" + & info.version .~ T.pack (_version version1) + & info.description ?~ "Hastructure is a white-label friendly Cashflow & Analytics Engine for MBS/ABS and REITs" + & info.license ?~ "BSD 3" + +-- showVersion :: Handler (Envelope '[] Version) +showVersion :: Handler Version +showVersion = return version1 + +runAsset :: RunAssetReq -> Handler RunAssetResp +runAsset req = return $ wrapRunAsset req + +runPool :: RunPoolReq -> Handler PoolRunResp +runPool (SingleRunPoolReq f pt passumption mRates) + = return $ + patchCumulativeToPoolRun <$> (wrapRunPoolType f pt passumption mRates) + +runPoolScenarios :: RunPoolReq -> Handler (Map.Map ScenarioName PoolRunResp) +runPoolScenarios (MultiScenarioRunPoolReq f pt mAssumps mRates) + = return $ Map.map (\assump -> + patchCumulativeToPoolRun <$> (wrapRunPoolType f pt (Just assump) mRates)) + mAssumps + +runDeal :: RunDealReq -> Handler RunResp +runDeal (SingleRunReq f dt assump nonPerfAssump) = return $ wrapRun f dt assump nonPerfAssump + + +-- 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 +stressDefaultAssetPerf r (AP.LoanAssump (Just da) mp mr ms) + = AP.LoanAssump (Just (AP.stressDefaultAssump r da)) mp mr ms +stressDefaultAssetPerf r (AP.InstallmentAssump (Just da) mp mr ms) + = AP.InstallmentAssump (Just (AP.stressDefaultAssump r da)) mp mr ms +stressDefaultAssetPerf r (AP.ReceivableAssump (Just da) mr ms) + = AP.ReceivableAssump (Just (AP.stressDefaultAssump r da)) mr ms +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 +modifyDealType dm f (RDeal d) = RDeal $ DM.modDeal dm f d +modifyDealType dm f (IDeal d) = IDeal $ DM.modDeal dm f d +modifyDealType dm f (LDeal d) = LDeal $ DM.modDeal dm f d +modifyDealType dm f (FDeal d) = FDeal $ DM.modDeal dm f d +modifyDealType dm f (UDeal d) = UDeal $ DM.modDeal dm f d +modifyDealType dm f (VDeal d) = VDeal $ DM.modDeal dm f d +modifyDealType dm f (PDeal d) = PDeal $ DM.modDeal dm f d + +queryDealType :: DealType -> Date -> DealStats -> Either String Rational +queryDealType (MDeal _d) = Q.queryCompound _d +queryDealType (RDeal _d) = Q.queryCompound _d +queryDealType (IDeal _d) = Q.queryCompound _d +queryDealType (LDeal _d) = Q.queryCompound _d +queryDealType (FDeal _d) = Q.queryCompound _d +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 +queryDealTypeBool (IDeal _d) d s = Q.queryDealBool _d s d +queryDealTypeBool (LDeal _d) d s = Q.queryDealBool _d s d +queryDealTypeBool (FDeal _d) d s = Q.queryDealBool _d s d +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 +getDealBondMap (IDeal d) = DB.bonds d +getDealBondMap (LDeal d) = DB.bonds d +getDealBondMap (FDeal d) = DB.bonds d +getDealBondMap (UDeal d) = DB.bonds d +getDealBondMap (VDeal d) = DB.bonds d +getDealBondMap (PDeal d) = DB.bonds d + +getDealFeeMap :: DealType -> Map.Map FeeName F.Fee +getDealFeeMap (MDeal d) = DB.fees d +getDealFeeMap (RDeal d) = DB.fees d +getDealFeeMap (IDeal d) = DB.fees d +getDealFeeMap (LDeal d) = DB.fees d +getDealFeeMap (FDeal d) = DB.fees d +getDealFeeMap (UDeal d) = DB.fees d +getDealFeeMap (VDeal d) = DB.fees d +getDealFeeMap (PDeal d) = DB.fees d + +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 + (dt ,Just stressed, stressedNonPerf, f) + +doTweak r (StressPoolPrepayment _) (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f) + = let + 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 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 (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving},f) tweak stop) + = return $ + let + 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 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 f dt mAssumps nonPerfAssump) + = return $ Map.map (\singleAssump -> wrapRun f dt (Just singleAssump) nonPerfAssump) mAssumps + +runMultiDeals :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) +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 + +runDealByRunScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) +runDealByRunScenarios (MultiRunAssumpReq f dt mAssump nonPerfAssumpMap) + = return $ Map.map (wrapRun f dt mAssump) nonPerfAssumpMap + +runDealByCombo :: RunDealReq -> Handler (Map.Map String RunResp) +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 f d a n) | (dk,d) <- dList, (ak,a) <- aList, (nk,n) <- nList ] + rMap = Map.fromList r + in + return rMap + +myServer :: ServerT API Handler +myServer = return engineSwagger + :<|> showVersion + :<|> runAsset + :<|> runPool + :<|> runPoolScenarios + :<|> runDeal + :<|> runDealScenarios + :<|> runMultiDeals + :<|> runDealByRunScenarios + :<|> runDealByCombo + :<|> runRootFinderBy + :<|> runDate + + +writeSwaggerJSON :: IO () +writeSwaggerJSON = BL8.writeFile "swagger.json" (encodePretty engineSwagger) + +data Config = Config { port :: Int} + deriving (Show,Generic) + +instance FromJSON Config + +app :: Application +app = simpleCors $ serve (Proxy :: Proxy API) myServer + +main :: IO () +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 (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 new file mode 100644 --- /dev/null +++ b/app/MainBase.hs @@ -0,0 +1,369 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ExistentialQuantification #-} + +module MainBase(DealType(..),RunResp,PoolTypeWrap(..),RunPoolTypeRtn,RunPoolTypeRtn_ + ,RunAssetReq(..),RunAssetResp,ScenarioName,DealRunInput,RunDealReq(..),RunSimDealReq(..),RunPoolReq(..) + ,RunDateReq(..),Version(..),RunRespRight + ,RootFindReq(..),RootFindResp(..),TargetBonds,PoolRunResp,RootFindTweak(..),RootFindStop(..) + ) + +where + +import Prelude () +import Prelude.Compat +import System.Environment +import Control.Monad.Catch (MonadCatch, MonadThrow (..)) +import Control.Monad.IO.Class (liftIO) +import Control.Monad (mapM) +import Control.Exception (Exception,throwIO,throw) +import Control.Monad.Except +import Control.Monad.Reader +import Data.Aeson +import Data.Aeson.Types +import Data.Aeson.TH +import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Attoparsec.ByteString +import Data.ByteString (ByteString) +import Data.List +import qualified Data.DList as DL +import Data.Map +import Data.Proxy +import qualified Data.Text as T +import Data.Maybe +import Data.Yaml as Y +import Data.OpenApi hiding (Server,contentType) +import qualified Data.Map as Map +import Data.String.Conversions +import Data.Time.Calendar +import GHC.Generics +import GHC.Real +import qualified Data.ByteString.Lazy.Char8 as BL8 +import qualified Data.ByteString.Char8 as BS +import Network.Wai +import Network.Wai.Handler.Warp +import Network.Wai.Middleware.Cors +import qualified Data.Aeson.Parser +import Language.Haskell.TH +import Network.HTTP.Types.Status +import Servant.OpenApi +import Servant +import Servant.Types.SourceT (source) +import Servant.API.ContentTypes (contentType) + +import Types +import qualified Deal as D +import qualified Deal.DealBase as DB +import qualified Deal.DealQuery as Q +import qualified Asset as Ast +import qualified Pool as P +import qualified Expense as F +import qualified Ledger as LD +import qualified AssetClass.Installment +import qualified AssetClass.Mortgage +import qualified AssetClass.Loan +import qualified AssetClass.Lease +import qualified AssetClass.ProjectedCashFlow +import qualified AssetClass.MixedAsset as MA +import qualified AssetClass.AssetBase as AB +import qualified Assumptions as AP +import qualified Cashflow as CF +import qualified Accounts as A +import qualified Revolving +import qualified Liability as L +import qualified Call as C +import qualified CreditEnhancement as CE +import qualified Hedge as HE +import qualified Waterfall as W +import qualified InterestRate as IR +import qualified Stmt +import qualified Triggers as TRG +import qualified Revolving as RV +import qualified Lib +import qualified Util as U +import qualified DateUtil as DU +import Data.Scientific (fromRationalRepetend,formatScientific, Scientific,FPFormat(Fixed)) +import Control.Lens +import qualified Types as W +import Cashflow (patchCumulative) + +data DealType = MDeal (DB.TestDeal AB.Mortgage) + | LDeal (DB.TestDeal AB.Loan) + | IDeal (DB.TestDeal AB.Installment) + | RDeal (DB.TestDeal AB.Lease) + | FDeal (DB.TestDeal AB.FixedAsset) + | VDeal (DB.TestDeal AB.Receivable) + | PDeal (DB.TestDeal AB.ProjectedCashflow) + | UDeal (DB.TestDeal AB.AssetUnion) + deriving(Show, Generic) + +makePrisms ''DealType + +data PoolTypeWrap = LPool (DB.PoolType AB.Loan) + | IPool (DB.PoolType AB.Installment) + | MPool (DB.PoolType AB.Mortgage) + | RPool (DB.PoolType AB.Lease) + | FPool (DB.PoolType AB.FixedAsset) + | VPool (DB.PoolType AB.Receivable) + | PPool (DB.PoolType AB.ProjectedCashflow) + | UPool (DB.PoolType AB.AssetUnion) + deriving(Show, Generic) + + +type RunPoolTypeRtn_ = Map.Map PoolId CF.PoolCashflow +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.AssetCashflow, Maybe [PriceResult]) + +type ScenarioName = String +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 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 Bool PoolTypeWrap (Maybe AP.ApplyAssumptionType) (Maybe [RateAssumption]) + | MultiScenarioRunPoolReq Bool PoolTypeWrap (Map.Map ScenarioName AP.ApplyAssumptionType) (Maybe [RateAssumption]) + deriving(Show, Generic) + + +data RunDateReq = RunDateReq Date DatePattern (Maybe Date) + deriving(Show, Generic) +instance ToSchema RunDateReq + +type PoolRunResp = Either String (Map.Map PoolId CF.PoolCashflow) + + +type TargetBonds = [BondName] +-- calcualte best spread that +--- 1. make sure all bonds are paid off +--- 2. make sure WAC cap is met +data RootFindReq = FirstLossReq DealRunInput BondName + | MaxSpreadToFaceReq DealRunInput BondName Bool Bool + | RootFinderReq DealRunInput RootFindTweak RootFindStop + deriving(Show, Generic) + +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 +instance ToSchema AB.AccrualPeriod +instance ToSchema AB.LeaseStepUp +instance ToSchema AB.Lease +instance ToSchema AB.FixedAsset +instance ToSchema AB.Receivable +instance ToSchema AB.ProjectedCashflow +instance ToSchema CutoffFields +instance ToSchema (P.Pool AB.Mortgage) +instance ToSchema (P.Pool AB.Loan) +instance ToSchema (P.Pool AB.Installment) +instance ToSchema (P.Pool AB.Lease) +instance ToSchema (P.Pool AB.FixedAsset) +instance ToSchema (P.Pool AB.Receivable) +instance ToSchema (P.Pool AB.AssetUnion) +instance ToSchema (P.Pool AB.ProjectedCashflow) +instance ToSchema AB.AssetUnion +instance ToSchema PoolId +instance ToSchema DealStatus +instance ToSchema DateType +instance ToSchema DB.DateDesp +instance ToSchema DB.ActionOnDate +instance ToSchema DealStats +instance ToSchema Cmp +instance ToSchema PricingMethod +instance ToSchema Stmt.TxnComment +instance ToSchema BookDirection +instance ToSchema Limit +instance ToSchema PoolSource +instance ToSchema (RoundingBy Rate) +instance ToSchema (RoundingBy Integer) +instance ToSchema (RoundingBy Balance) +instance ToSchema DealCycle +instance ToSchema (Table Balance Balance) +instance ToSchema (Table Float Spread) +instance ToSchema A.Account +instance ToSchema A.InterestInfo +instance ToSchema F.Fee +instance ToSchema F.FeeType +instance ToSchema HE.RateCap +instance ToSchema LD.Ledger +instance ToSchema A.ReserveAmount +instance ToSchema L.Bond +instance ToSchema L.StepUp +instance ToSchema L.BondType +instance ToSchema L.OriginalInfo +instance ToSchema L.InterestInfo +instance ToSchema L.InterestOverInterestType +instance ToSchema (PerPoint (Ratio Integer)) +instance ToSchema (PerCurve Rate) +instance ToSchema Pre +instance ToSchema W.PayOrderBy +instance ToSchema W.ActionWhen +instance ToSchema W.ExtraSupport +instance ToSchema W.Action +instance ToSchema W.BookType +instance ToSchema W.CollectionRule +instance ToSchema C.CallOption +instance ToSchema CE.LiqCreditCalc +instance ToSchema CE.LiqFacility +instance ToSchema HE.RateSwap +instance ToSchema HE.RateSwapType +instance ToSchema HE.RateSwapBase +instance ToSchema HE.CurrencySwap +instance ToSchema CE.LiqSupportType +instance ToSchema CE.LiqRepayType +instance ToSchema CE.LiqDrawType +instance ToSchema CustomDataType +instance ToSchema TRG.Trigger +instance ToSchema TRG.TriggerEffect +instance ToSchema Types.BalanceSheetReport +instance ToSchema Types.CashflowReport +instance ToSchema Types.BookItem +-- instance ToSchema a => ToSchema (DL.DList a) +instance ToSchema Types.Txn + +-- instance ToSchema (DL.DList Types.Txn) where +-- declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [Types.Txn]) + +-- instance ToSchema (Generic (DL.DList Types.Txn)) +-- instance ToSchema (DL.DList Types.Txn) +instance ToSchema a => ToSchema (DL.DList a) where + declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a]) + +instance ToSchema Stmt.Statement +instance ToSchema AB.AssociateExp +instance ToSchema AB.AssociateIncome +instance ToSchema RV.RevolvingPool +instance ToSchema (TsPoint [AB.AssetUnion]) +instance ToSchema AP.IssueBondEvent +instance ToSchema (TsPoint AP.IssueBondEvent) +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 +instance ToSchema AP.IrrType +instance ToSchema AP.BondPricingInput +instance ToSchema AP.RevolvingAssumption +instance ToSchema AP.TagMatchRule +instance ToSchema RangeType +instance ToSchema AP.FieldMatchRule +instance ToSchema AP.ObligorStrategy +instance ToSchema AP.ApplyAssumptionType +instance ToSchema AP.LeaseEndType +instance ToSchema AP.LeaseDefaultType +instance ToSchema AP.AssetPerfAssumption +instance ToSchema AP.AssetDelinqPerfAssumption +instance ToSchema AP.AssetDefaultedPerfAssumption +instance ToSchema AP.AssetDefaultAssumption +instance ToSchema AP.AssetPrepayAssumption +instance ToSchema AP.RecoveryAssumption +instance ToSchema RateAssumption +instance ToSchema AP.ExtraStress +instance ToSchema AP.AssetDelinquencyAssumption +instance ToSchema AP.LeaseAssetGapAssump +instance ToSchema AP.LeaseAssetRentAssump +instance ToSchema Threshold +instance ToSchema DB.DealStatFields +instance ToSchema (PerPoint Balance) +instance ToSchema (PerCurve Balance) +instance ToSchema (DB.TestDeal AB.Mortgage) +instance ToSchema (DB.TestDeal AB.Loan) +instance ToSchema (DB.TestDeal AB.Installment) +instance ToSchema (DB.TestDeal AB.Lease) +instance ToSchema (DB.TestDeal AB.Receivable) +instance ToSchema (DB.TestDeal AB.ProjectedCashflow) +instance ToSchema (DB.TestDeal AB.AssetUnion) +instance ToSchema (DB.TestDeal AB.FixedAsset) +instance ToSchema (DB.PoolType AB.Mortgage) +instance ToSchema (DB.PoolType AB.Loan) +instance ToSchema (DB.PoolType AB.Installment) +instance ToSchema (DB.PoolType AB.Lease) +instance ToSchema (DB.PoolType AB.FixedAsset) +instance ToSchema (DB.PoolType AB.Receivable) +instance ToSchema (DB.PoolType AB.ProjectedCashflow) +instance ToSchema (DB.PoolType AB.AssetUnion) +instance ToSchema (DB.UnderlyingDeal AB.Mortgage) +instance ToSchema (DB.UnderlyingDeal AB.Loan) +instance ToSchema (DB.UnderlyingDeal AB.Installment) +instance ToSchema (DB.UnderlyingDeal AB.Lease) +instance ToSchema (DB.UnderlyingDeal AB.FixedAsset) +instance ToSchema (DB.UnderlyingDeal AB.Receivable) +instance ToSchema (DB.UnderlyingDeal AB.ProjectedCashflow) +instance ToSchema (DB.UnderlyingDeal AB.AssetUnion) +instance ToSchema ResultComponent +instance ToSchema PriceResult +instance ToSchema DealType + +-- $(concat <$> traverse (deriveJSON defaultOptions) [''DealType,''RootFindResp]) +$(deriveJSON defaultOptions ''DealType) +$(deriveJSON defaultOptions ''RootFindResp) +$(deriveJSON defaultOptions ''RootFindReq) +$(concat <$> traverse (deriveJSON defaultOptions) [''RunDealReq, ''RunPoolReq,''RunAssetReq, ''RunDateReq,''PoolTypeWrap]) + +data Version = Version + { _version :: String + } deriving (Eq, Show, Generic) + +$(deriveJSON defaultOptions ''Version) +instance ToSchema Version +instance ToSchema RunDealReq +instance ToSchema PoolTypeWrap +instance ToSchema RunPoolReq +instance ToSchema RunAssetReq +instance ToSchema RootFindResp diff --git a/src/Accounts.hs b/src/Accounts.hs new file mode 100644 --- /dev/null +++ b/src/Accounts.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Accounts (Account(..),ReserveAmount(..),draw,deposit + ,transfer,depositInt ,InterestInfo(..),buildEarnIntAction + ,accBalLens,tryDraw,buildRateResetDates,accrueInt,accTypeLens) + where +import qualified Data.Time as T +import Stmt (Statement(..),appendStmt,getTxnBegBalance,getDate + ,TxnComment(..),QueryByComment(..),getTxnComment,getTxnAmt,weightAvgBalanceByDates) +import Types +import Lib +import Util +import DateUtil +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import GHC.Generics +import Control.Lens.Tuple +import Control.Lens hiding (Index) +import qualified InterestRate as IR +import qualified Data.DList as DL + +-- import Web.Hyperbole + +import Debug.Trace +debug = flip trace + +data InterestInfo = BankAccount IRate DatePattern Date + -- ^ fix reinvest return rate + | InvestmentAccount Types.Index Spread DatePattern DatePattern Date IRate + -- ^ float type: index, spread, sweep dates, rate reset , last accrue day, last reset rate + deriving (Show, Generic,Eq,Ord) + +data ReserveAmount = PctReserve DealStats Rate -- ^ target amount with reference to % of formula + | FixReserve Balance -- ^ target amount with fixed balance amount + | Either Pre ReserveAmount ReserveAmount -- ^ target amount depends on a test, if true, then use first one ,otherwise use second one + | Max [ReserveAmount] -- ^ use higher of all reserve formulas + | Min [ReserveAmount] -- ^ use lower of all reserve formulas + deriving (Show, Eq, Generic, Ord) + +data Account = Account { + accBalance :: Balance -- ^ account current balance + ,accName :: String -- ^ account name + ,accInterest :: Maybe InterestInfo -- ^ account reinvestment interest + ,accType :: Maybe ReserveAmount -- ^ target info if a reserve account + ,accStmt :: Maybe Statement -- ^ transactional history +} deriving (Show, Generic,Eq, Ord) + +-- | build interest earn actions +buildEarnIntAction :: [Account] -> Date -> [(String,Dates)] -> [(String,Dates)] +buildEarnIntAction [] ed r = r +buildEarnIntAction (acc:accs) ed r = + case accInterest acc of + Nothing -> buildEarnIntAction accs ed r + Just (BankAccount _ dp lastAccDate ) + -> buildEarnIntAction accs ed [(accName acc, genSerialDatesTill2 NO_IE lastAccDate dp ed)]++r + Just (InvestmentAccount _ _ dp _ lastAccDate _) + -> buildEarnIntAction accs ed [(accName acc, genSerialDatesTill2 NO_IE lastAccDate dp ed)]++r + +accrueInt :: Date -> Account -> Balance +accrueInt _ (Account _ _ Nothing _ _) = 0 +-- ^ bank account type interest +accrueInt endDate a@(Account bal _ (Just interestType) _ stmt) + = case stmt of + Nothing -> mulBR (mulBI bal rateToUse) (yearCountFraction defaultDc lastDay endDate) -- `debug` (">>"++show lastCollectDate++">>"++show ed) + Just (Statement txns) -> + let + accrueTxns = sliceBy IE lastDay endDate (DL.toList txns) + bals = map getTxnBegBalance accrueTxns ++ [bal] + ds = [lastDay] ++ getDates accrueTxns ++ [endDate] + avgBal = calcWeightBalanceByDates defaultDc bals ds + in + mulBI avgBal rateToUse + where + defaultDc = DC_30E_360 + (lastDay,rateToUse) = case interestType of + (BankAccount r dp lastCollectDate) -> (lastCollectDate, r) + (InvestmentAccount idx spd dp _ lastCollectDate lastRate) -> (lastCollectDate, lastRate) + +-- | sweep interest/investement income into account +depositInt :: Date -> Account -> Account +depositInt _ a@(Account _ _ Nothing _ _) = a +depositInt ed a@(Account bal _ (Just intType) _ stmt) + = a {accBalance = newBal ,accStmt= appendStmt newTxn stmt ,accInterest = Just (newIntInfoType intType)} + where + accruedInt = accrueInt ed a + newIntInfoType (BankAccount x y _d) = BankAccount x y ed + newIntInfoType (InvestmentAccount x y z z1 _d z2) = InvestmentAccount x y z z1 ed z2 + newBal = accruedInt + bal + newTxn = AccTxn ed newBal accruedInt BankInt + +-- | move cash from account A to account B +transfer :: (Account,Account) -> Date -> Amount -> (Account, Account) +transfer (sourceAcc@(Account sBal san _ _ sStmt), targetAcc@(Account tBal tan _ _ tStmt)) + d + amount + = (sourceAcc {accBalance = newSBal, accStmt = sourceNewStmt} + ,targetAcc {accBalance = newTBal, accStmt = targetNewStmt}) + where + newSBal = sBal - amount + newTBal = tBal + amount + sourceNewStmt = appendStmt (AccTxn d newSBal (- amount) (Transfer san tan)) sStmt + targetNewStmt = appendStmt (AccTxn d newTBal amount (Transfer san tan)) tStmt + +-- | deposit cash to account with a comment +deposit :: Amount -> Date -> TxnComment -> Account -> Account +deposit amount d source acc@(Account bal _ _ _ maybeStmt) = + acc {accBalance = newBal, accStmt = newStmt} + where + newBal = bal + amount + newStmt = appendStmt (AccTxn d newBal amount source) maybeStmt + +-- | draw cash from account with a comment +draw :: Amount -> Date -> TxnComment -> Account -> Account +draw amount d txn acc@Account{ accBalance = bal ,accName = an} + | bal >= amount = deposit (- amount) d txn acc + | otherwise = error $ "Date:"++ show d ++" Failed to draw "++ show amount ++" from account" ++ an + +-- | draw cash from account with a comment,return shortfall and acccount +tryDraw :: Amount -> Date -> TxnComment -> Account -> ((Amount,Amount),Account) +tryDraw amt d tc acc@(Account bal _ _ _ maybeStmt) + | amt > bal = ((amt - bal, bal), acc {accBalance = 0}) + | otherwise = ((0, amt), draw amt d tc acc) + + +instance QueryByComment Account where + queryStmt (Account _ _ _ _ Nothing) tc = [] + queryStmt (Account _ _ _ _ (Just (Statement txns))) tc = filter (\x -> getTxnComment x == tc) (DL.toList txns) + + +-- InvestmentAccount Types.Index Spread DatePattern DatePattern Date IRate +buildRateResetDates :: Date -> Account -> Maybe (String,Dates) +buildRateResetDates ed Account{accName = n, accInterest = Just (InvestmentAccount _ _ _ dp sd _) } + = Just (n, genSerialDatesTill2 NO_IE sd dp ed) +buildRateResetDates _ _ = Nothing + + +makeLensesFor [("accBalance","accBalLens") ,("accName","accNameLens") + ,("accType","accTypeLens") ,("accStmt","accStmtLens"),("accInterest","accIntLens")] ''Account + + +instance IR.UseRate Account where + isAdjustbleRate (Account _ an (Just (InvestmentAccount _ _ _ _ _ _)) _ _) = True + isAdjustbleRate _ = False + + getIndex (Account _ an (Just (InvestmentAccount idx _ _ _ _ _)) _ _) = Just idx + getIndex _ = Nothing + + +makePrisms ''InterestInfo + +$(deriveJSON defaultOptions ''InterestInfo) +$(deriveJSON defaultOptions ''ReserveAmount) +$(deriveJSON defaultOptions ''Account) diff --git a/src/Analytics.hs b/src/Analytics.hs new file mode 100644 --- /dev/null +++ b/src/Analytics.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Analytics (calcConvexity,calcDuration,pv,calcWAL,pv2,pv3 + ,fv2,pv21,calcRequiredAmtForIrrAtDate,calcIRR + ,calcSurvivorFactors) + + where +import Types +import Lib +import Util +import DateUtil +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import GHC.Generics +import Data.Ratio +import Numeric.RootFinding + +import Debug.Trace +debug = flip trace + +calcSurvivorFactors :: Date -> [Date] -> Double -> [Double] +calcSurvivorFactors sd ds 0 = replicate (length ds) 1.0 +calcSurvivorFactors sd ds survivalRate = + let + yearFractions::[Double] = [ realToFrac (daysBetween sd d) / 365.0 | d <- ds ] + factors = [ (1 - survivalRate) ** x | x <- yearFractions ] + in + factors + +-- ^ calculate the Weighted Average Life of cashflow, with unit option to Monthly or Yearly +calcWAL :: TimeHorizion -> Balance -> Date -> [(Balance,Date)] -> Balance +calcWAL th bal d ps = + let + interval = case th of + ByYear -> 365 + ByMonth -> 30 + weightedAmts = [ mulBR futureAmt ((daysBetween d futureDate) % interval) | (futureAmt,futureDate) <- ps ] + in + sum weightedAmts / bal + +calcDuration :: DayCount -> Date -> [(Date,Balance)] -> Ts -> Rate +calcDuration dc d ps pricingCurve + = (foldr (\(_d,_b) acc -> + (*) + (divideBB (pv pricingCurve d _d _b) presentValue) + (yearCountFraction dc d _d) + + acc) + 0.0000 + ps) + where + presentValue = sum [ pv pricingCurve d _d _b | (_d,_b) <- ps ] + +calcConvexity :: DayCount -> Date -> [(Date,Balance)] -> Ts -> Rate +calcConvexity dc d ps pricingCurve + = toRational $ + (*) + presentValue' $ + (foldr (\(_t,_c,_f) acc -> + (_t * (_t + 1) * fromRational _c) / ((1.000 + _f) ** (_t+2)) + ) + 0.0000 + (zip3 ts payments pvFactors)) -- `debug` ("'v"++show presentValue'++"others"++ show (zip3 ts payments pvFactors)) + where + pvFactors::[Double] = fromRational <$> getValByDate pricingCurve Inc <$> fst <$> ps + presentValue'::Double = 1 / (fromRational . toRational) (sum [ pv pricingCurve d _d _b | (_d,_b) <- ps ]) + payments = toRational . snd <$> ps + ts::[Double] = fromRational <$> yearCountFraction dc d <$> fst <$> ps + +-- ^ calculate present value of input amount in future with given a curve and PV date +pv :: Ts -> Date -> Date -> Amount -> Amount +pv pc today d amt = + realToFrac $ (realToFrac amt) * (1 / factor) -- `debug` ("DF:"++show factor++" PV AMT"++show amt) + where + distance::Double = fromIntegral $ daysBetween today d + discount_rate = fromRational $ getValByDate pc Exc d -- `debug` ("Get val by ts"++show pc ++">>d"++ show d) + factor::Double = (1 + realToFrac discount_rate) ** (distance / 365) -- `debug` ("discount_rate"++show(discount_rate) ++" dist days=>"++show(distance)) + +-- ^ calculate present value in the future using constant rate +pv2 :: IRate -> Date -> Date -> Amount -> Amount +pv2 discount_rate today d amt + | today == d = amt + | otherwise + = realToFrac $ (realToFrac amt) * (1/denominator) -- `debug` ("pv: cash"++ show amt++" deno"++ show denominator++">> rate"++show discount_rate) + where + denominator::Double = (1 + realToFrac discount_rate) ** (distance / 365) + distance::Double = fromIntegral $ daysBetween today d -- `debug` ("days betwwen"++ show (daysBetween today d)++">>"++ show d ++ ">>today>>"++ show today) + +-- ^ calculate present value to specific date given a series of amount with dates +pv21 :: IRate -> Date -> [Date] -> [Amount] -> Balance +pv21 r d ds vs = sum [ pv2 r d _d amt | (_d,amt) <- zip ds vs ] + +-- ^ using double for ridder's method + +pv2' :: Double -> Date -> Date -> Double -> Double +pv2' r today d amt + | amt == 0 = 0 + | today == d = amt + | otherwise + = amt * (1/denominator) -- `debug` ("pv: cash"++ show amt++" deno"++ show denominator++">> rate"++show discount_rate) + where + denominator::Double = (1 + r) ** (distance / 365) + distance::Double = fromIntegral $ daysBetween today d -- `debug` ("days betwwen"++ show (daysBetween today d)++">>"++ show d ++ ">>today>>"++ show today) + +pv22 :: Double -> Date -> [Date] -> [Double] -> Double +pv22 r d ds vs = sum [ pv2' r d _d amt | (_d,amt) <- zip ds vs ] + +-- ^ calcualte present value given a series of amount with dates +pv3 :: Ts -> Date -> [Date] -> [Amount] -> Balance +pv3 pvCurve pricingDate ds vs + = let + rs = fromRational <$> getValByDates pvCurve Inc ds + pvs = [ pv2 r pricingDate d amt | (r,d,amt) <- zip3 rs ds vs ] + in + sum pvs + +pv3' :: Ts -> Date -> [Date] -> [Amount] -> Balance +pv3' pvCurve pricingDate ds vs + = let + rs = fromRational <$> getValByDates pvCurve Inc ds + vs' = (fromRational . toRational) <$> vs + pvs = [ pv2' r pricingDate d amt | (r,d,amt) <- zip3 rs ds vs' ] + in + fromRational . toRational $ foldr (+) 0 pvs + + +fv2 :: IRate -> Date -> Date -> Amount -> Amount +fv2 discount_rate today futureDay amt + = realToFrac $ realToFrac amt * factor + where + factor::Double = (1 + realToFrac discount_rate) ** (distance / 365) + distance::Double = fromIntegral $ daysBetween today futureDay + + +calcPvFromIRR :: Double -> [Date] -> [Amount] -> Date -> Double -> Double +calcPvFromIRR irr [] _ d amt = 0 +calcPvFromIRR irr ds vs d amt = + let + begDate = head ds + vs' = fromRational . toRational <$> vs + pv = pv22 irr begDate (ds++[d]) (vs'++[amt]) + in + (fromRational . toRational) pv + +-- ^ calculate IRR of a series of cashflow +calcRequiredAmtForIrrAtDate :: Double -> [Date] -> [Amount] -> Date -> Maybe Amount +calcRequiredAmtForIrrAtDate irr [] _ d = Nothing +calcRequiredAmtForIrrAtDate irr ds vs d = + let + itertimes = 500 + 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 + +-- ^ 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:"++ 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 + def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.000001} + beginDate = head ds + vs' = fromRational . toRational <$> 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 diff --git a/src/Asset.hs b/src/Asset.hs new file mode 100644 --- /dev/null +++ b/src/Asset.hs @@ -0,0 +1,384 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} + +module Asset ( Asset(..), + buildAssumptionPpyDefRecRate,buildAssumptionPpyDelinqDefRecRate + ,calcRecoveriesFromDefault,getCurBalance + ,priceAsset,applyHaircut,buildPrepayRates,buildDefaultRates,getObligorFields + ,getObligorTags,getObligorId,getRecoveryLagAndRate,getDefaultDelinqAssump,getOriginInfo +) where + +import qualified Data.Time as T +import qualified Data.Text as Text +import Text.Read (readMaybe) + +import Lib (Period(..) + ,Ts(..),periodRateFromAnnualRate,toDate + ,getIntervalDays,zipWith9,mkTs,periodsBetween + ,mkRateTs,daysBetween, getIntervalFactors) + +import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) +import qualified Assumptions as A +import qualified AssetClass.AssetBase as ACM +import AssetClass.AssetCashflow + +import qualified Data.Map as Map +import Analytics +import Data.List +import Data.Maybe +import Data.Ratio +import Data.Aeson hiding (json) +import Language.Haskell.TH +import GHC.Generics +import Data.Aeson.TH +import Data.Aeson.Types +import Types hiding (Current) +import Text.Printf +import Data.Fixed +import qualified InterestRate as IR +import qualified Data.Set as Set +import Util + +import AssetClass.AssetBase ( OriginalInfo(..), calcPmt, AssetUnion, Obligor(..) ) + +import Debug.Trace +import Assumptions (ExtraStress(ExtraStress)) + +import Control.Lens hiding (element) +import Control.Lens.TH +import Data.Generics.Product.Fields +import Data.Generics.Product.Any +import DateUtil (yearCountFraction) + + +debug = flip trace + +class (Show a,IR.UseRate a) => Asset a where + -- | project contractual cashflow of an asset with interest assumptions + calcCashflow :: a -> Date -> Maybe [RateAssumption] -> Either String CF.CashFlowFrame + -- | Get current balance of an asset + getCurrentBal :: a -> Balance + -- | Get original balance of an asset + getOriginBal :: a -> Balance + -- | Get original rate of an asset + getOriginRate :: a -> IRate + -- | Get current rate of an asset + getCurrentRate :: a -> IRate + -- | Get origination date of an asset + getOriginDate :: a -> Date + -- | Get origin info of an asset + getOriginInfo :: a -> OriginalInfo + -- | if the asset is defaulted + isDefaulted :: a -> Bool + -- | project projected dates of an asset + getPaymentDates :: a -> Int -> [Date] + -- | get number of remaining payments + getRemainTerms :: a -> Int + -- | get remain payment dates + getRemainDates :: a -> [Date] + getRemainDates a = lastN (getRemainTerms a) (getPaymentDates a 0) + -- | project asset cashflow under credit stress and interest assumptions + getTotalTerms :: a -> Int + getTotalTerms a = ACM.originTerm (getOriginInfo a) + + getPastTerms :: a -> Int + getPastTerms a = getTotalTerms a - getRemainTerms a + + projCashflow :: a -> Date -> A.AssetPerf -> Maybe [RateAssumption] -> Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance) + -- | Get possible number of borrower + getBorrowerNum :: a -> Int + -- | Split asset per rates passed in + splitWith :: a -> [Rate] -> [a] + -- | ! Change the origination date of an asset + updateOriginDate :: a -> Date -> a + -- | ! Change the current asset state to the date of origination + resetToOrig :: a -> a + -- | Get Last Interest Payment date + getLastInterestPaymentDate :: a -> Maybe Date + -- | Calculate Accrued Interest + calcAccruedInterest :: a -> Date -> Balance + -- | ! Internal use + calcAlignDate :: a -> Date -> Date + calcAlignDate ast d = let + payDates = Asset.getOriginDate ast:getPaymentDates ast 0 + remainTerms = getRemainTerms ast + benchDate = reverse payDates!! remainTerms + offset = daysBetween benchDate d + in + T.addDays offset $ Asset.getOriginDate ast + + getObligor :: a -> Maybe Obligor + getObligor a = + case getOriginInfo a of + FixedAssetInfo {} -> Nothing + MortgageOriginalInfo{obligor = x } -> x + LoanOriginalInfo{obligor = x } -> x + LeaseInfo{obligor = x } -> x + ReceivableInfo{obligor = x } -> x + + getObligorTags :: a -> Set.Set String + getObligorTags a = + case getOriginInfo a of + MortgageOriginalInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) + LoanOriginalInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) + LeaseInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) + ReceivableInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) + _ -> mempty + + getObligorId :: a -> Maybe String + getObligorId a = + case getOriginInfo a of + MortgageOriginalInfo{obligor = Just obr } -> Just (obligorId obr) + LoanOriginalInfo{obligor = Just obr } -> Just (obligorId obr) + LeaseInfo{obligor = Just obr } -> Just (obligorId obr) + ReceivableInfo{obligor = Just obr } -> Just (obligorId obr) + _ -> Nothing + + getObligorFields :: a -> Maybe (Map.Map String (Either String Double)) + getObligorFields a = + let + obInfo = getObligor a + in + case obInfo of + Nothing -> Nothing + Just ob -> Just (obligorFields ob) + + {-# MINIMAL calcCashflow,getCurrentBal,getOriginBal,getOriginRate #-} + + + +-- | apply ExtraStress on prepayment/default rates +applyExtraStress :: Maybe A.ExtraStress -> [Date] -> [Rate] -> [Rate] -> ([Rate],[Rate]) +applyExtraStress Nothing _ ppy def = (ppy,def) +applyExtraStress (Just ExtraStress{A.defaultFactors= mDefFactor + ,A.prepaymentFactors = mPrepayFactor}) ds ppy def = + case (mPrepayFactor,mDefFactor) of + (Nothing,Nothing) -> (ppy,def) + (Nothing,Just defFactor) -> (ppy ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor) + (Just ppyFactor,Nothing) -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor, def) + (Just ppyFactor,Just defFactor) -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor + ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor) + + +cpr2smm :: Rate -> Rate +cpr2smm r = toRational $ 1 - (1 - fromRational r :: Double) ** (1/12) + +normalPerfVector :: [Rate] -> [Rate] +normalPerfVector = floorWith 0.0 . capWith 1.0 + +buildPrepayRates :: Asset b => b -> [Date] -> Maybe A.AssetPrepayAssumption -> Either String [Rate] +buildPrepayRates _ ds Nothing = Right $ replicate (pred (length ds)) 0.0 +buildPrepayRates a ds mPa = + normalPerfVector <$> + case mPa of + Just (A.PrepaymentConstant r) -> Right $ replicate size r + Just (A.PrepaymentCPR r) -> Right $ Util.toPeriodRateByInterval r <$> getIntervalDays ds + Just (A.PrepaymentVec vs) -> Right $ zipWith + Util.toPeriodRateByInterval + (paddingDefault 0.0 vs (pred size)) + (getIntervalDays ds) + Just (A.PrepaymentVecPadding vs) -> Right $ zipWith + Util.toPeriodRateByInterval + (paddingDefault (last vs) vs (pred size)) + (getIntervalDays ds) + Just (A.PrepayStressByTs ts x) -> + do + rs <- buildPrepayRates a ds (Just x) + return $ getTsVals $ multiplyTs Exc (zipTs (tail ds) rs) ts + Just (A.PrepaymentPSA r) -> + let + agedTerm = getPastTerms a + remainingTerm = getRemainTerms a + ppyVectorInCPR = (* r) <$> [0.002,0.004..0.06] ++ repeat 0.06 + vectorUsed = take remainingTerm $ drop agedTerm ppyVectorInCPR + in + case period (getOriginInfo a) of + Monthly -> Right $ cpr2smm <$> vectorUsed + _ -> Left $ "PSA is only supported for monthly payment but got "++ show (period (getOriginInfo a)) + Just (A.PrepaymentByTerm rs) -> + let + agedTerm = getPastTerms a + oTerm = originTerm (getOriginInfo a) + in + case find (\x -> oTerm == length x) rs of + Just v -> Right $ drop agedTerm v + Nothing -> Left "Prepayment by term doesn't match the origin term" + + _ -> Left ("failed to find prepayment type"++ show mPa) + where + size = length ds + +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 + Just (A.DefaultConstant r) -> Right $ replicate size r + Just (A.DefaultCDR r) -> Right $ Util.toPeriodRateByInterval r <$> getIntervalDays ds + Just (A.DefaultVec vs) -> Right $ zipWith + Util.toPeriodRateByInterval + (paddingDefault 0.0 vs (pred size)) + (getIntervalDays ds) + Just (A.DefaultVecPadding vs) -> Right $ zipWith + Util.toPeriodRateByInterval + (paddingDefault (last vs) vs (pred size)) + (getIntervalDays ds) + Just (A.DefaultAtEndByRate r rAtEnd) + -> Right $ case size of + 0 -> [] + 1 -> [] + _ -> (Util.toPeriodRateByInterval r <$> getIntervalDays (init ds)) ++ (Util.toPeriodRateByInterval rAtEnd <$> getIntervalDays [head ds,last ds]) + + Just (A.DefaultStressByTs ts x) -> + do + rs <- buildDefaultRates a ds (Just x) + let r = getTsVals $ multiplyTs Inc (zipTs (tail ds) rs) ts + return r + + Just (A.DefaultByTerm rs) -> + let + agedTerm = getPastTerms a + oTerm = originTerm (getOriginInfo a) + in + case find (\x -> oTerm == length x) rs of + Just v -> Right $ drop agedTerm v + Nothing -> Left "Default by term doesn't match the origin term" + _ -> Left ("failed to find default rate type"++ show mDa) + where + size = length ds + +getRecoveryLagAndRate :: Maybe A.RecoveryAssumption -> (Rate,Int) +getRecoveryLagAndRate Nothing = (0,0) +getRecoveryLagAndRate (Just (A.Recovery (r,lag))) = (r,lag) + +-- | build pool assumption rate (prepayment, defaults, recovery rate , recovery lag) +buildAssumptionPpyDefRecRate :: Asset a => a -> [Date] -> A.AssetPerfAssumption -> Either String ([Rate],[Rate],Rate,Int) +buildAssumptionPpyDefRecRate a ds (A.LoanAssump mDa mPa mRa mESa) = buildAssumptionPpyDefRecRate a ds (A.MortgageAssump mDa mPa mRa mESa) +buildAssumptionPpyDefRecRate a ds (A.MortgageAssump mDa mPa mRa mESa) + = let + size = length ds + zeros = replicate size 0.0 + (recoveryRate,recoveryLag) = getRecoveryLagAndRate mRa + in + do + prepayRates <- buildPrepayRates a ds mPa + defaultRates <- buildDefaultRates a ds mDa + let (prepayRates2,defaultRates2) = applyExtraStress mESa ds prepayRates defaultRates + return (prepayRates2,defaultRates2,recoveryRate,recoveryLag) + + +getDefaultDelinqAssump :: Maybe A.AssetDelinquencyAssumption -> [Date] -> ([Rate],Int,Rate) +getDefaultDelinqAssump Nothing ds = (replicate (length ds) 0.0, 0, 0.0) +getDefaultDelinqAssump (Just (A.DelinqCDR r (lag,pct))) ds = (map (Util.toPeriodRateByInterval r) (getIntervalDays ds) + ,lag + ,pct) + +getDefaultLagAndRate :: Maybe A.RecoveryAssumption -> (Rate,Int) +getDefaultLagAndRate Nothing = (0,0) +getDefaultLagAndRate (Just (A.Recovery (r,lag))) = (r,lag) + +-- | build prepayment rates/ delinq rates and (%,lag) convert to default, recovery rate, recovery lag +buildAssumptionPpyDelinqDefRecRate :: Asset a => a -> [Date] -> A.AssetPerfAssumption -> Either String ([Rate],[Rate],(Rate,Lag),Rate,Int) +buildAssumptionPpyDelinqDefRecRate _ ds (A.MortgageDeqAssump mDeqDefault mPa mRa (Just _)) = Left "Delinq assumption doesn't support extra stress" +buildAssumptionPpyDelinqDefRecRate a ds (A.MortgageDeqAssump mDeqDefault mPa mRa Nothing) + = let + (recoveryRate,recoveryLag) = getRecoveryLagAndRate mRa + zeros = replicate (length ds) 0.0 + (delinqRates,defaultLag,defaultPct) = case mDeqDefault of + Nothing -> (zeros,0,0.0) + Just (A.DelinqCDR r (lag,pct)) -> + (map (Util.toPeriodRateByInterval r) (getIntervalDays ds) + ,lag + ,pct) + in + do + prepayRates <- buildPrepayRates a ds mPa + return (prepayRates,delinqRates,(defaultPct,defaultLag),recoveryRate, recoveryLag) + + +calcRecoveriesFromDefault :: Balance -> Rate -> [Rate] -> [Amount] +calcRecoveriesFromDefault bal recoveryRate recoveryTiming + = mulBR recoveryAmt <$> recoveryTiming + where + recoveryAmt = mulBR bal recoveryRate + +priceAsset :: Asset a => a -> Date -> PricingMethod -> A.AssetPerf -> Maybe [RateAssumption] -> CutoffType + -> Either String PriceResult +priceAsset m d (PVCurve curve) assumps mRates cType + = let + cr = getCurrentRate m + pDays = Asset.getOriginDate m:(getPaymentDates m 0) + cb = getCurrentBal m + in + case projCashflow m d assumps mRates of + Right (CF.CashFlowFrame _ txns,_) -> + let + ds = getDate <$> txns + accruedInt = case ds of + [] -> 0 + (fstTxnDate:_) -> + let + accStartDate = last $ takeWhile (< fstTxnDate) pDays + in + mulBR (mulBIR cb cr) (yearCountFraction DC_ACT_365F accStartDate d) + amts = CF.tsTotalCash <$> (case cType of + Exc -> CF.clawbackInt accruedInt txns + Inc -> txns) + pv = pv3 curve d ds amts -- `debug` ("pricing"++ show d++ show ds++ show amts) + wal = calcWAL ByYear cb d (zip amts ds) + duration = fromRational $ calcDuration DC_ACT_365F d (zip ds amts) curve + convexity = fromRational $ calcConvexity DC_ACT_365F d (zip ds amts) curve + in + Right $ AssetPrice pv wal duration convexity accruedInt + Left x -> Left x + +priceAsset m d (BalanceFactor currentFactor defaultedFactor) assumps mRates cType + = let + cb = getCurrentBal m + val = if isDefaulted m then + mulBR cb defaultedFactor -- `debug` ("Defulat CB"++ show cb) + else + mulBR cb currentFactor -- `debug` ("CB"++ show cb) + in + case projCashflow m d assumps mRates of + Right (CF.CashFlowFrame _ txns,_) -> + let ds = getDate <$> txns + amts = CF.tsTotalCash <$> txns + wal = calcWAL ByYear cb d (zip amts ds) -- `debug` ("pricing"++ show d++ show ds++ show amts) + in + Right $ AssetPrice val wal (-1) (-1) (-1) + Left x -> Left x + +priceAsset m d (PvRate r) assumps mRates cType + = let + cb = getCurrentBal m + pDays = Asset.getOriginDate m:getPaymentDates m 0 + cr = getCurrentRate m + in + case projCashflow m d assumps mRates of + Right (CF.CashFlowFrame _ txns,_) -> + let ds = getDate <$> txns + accruedInt = case ds of + [] -> 0 + (fstTxnDate:_) -> + let + accStartDate = last $ takeWhile (< fstTxnDate) pDays + in + mulBR (mulBIR cb cr) (yearCountFraction DC_ACT_365F accStartDate d) + amts = CF.tsTotalCash <$> (case cType of + Exc -> CF.clawbackInt accruedInt txns + Inc -> txns) + wal = calcWAL ByYear cb d (zip amts ds) + pv = sum $ zipWith (pv2 r d) ds amts + curve = mkTs $ zip ds (repeat (toRational r)) + duration = fromRational $ calcDuration DC_ACT_365F d (zip ds amts) curve + convexity = fromRational $ calcConvexity DC_ACT_365F d (zip ds amts) curve + in + Right $ AssetPrice pv wal duration convexity accruedInt + Left x -> Left x diff --git a/src/AssetClass/AssetBase.hs b/src/AssetClass/AssetBase.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/AssetBase.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE BangPatterns #-} + +module AssetClass.AssetBase + (Installment(..),Lease(..),OriginalInfo(..),Status(..) + ,LeaseStepUp(..),AccrualPeriod(..),PrepayPenaltyType(..) + ,AmortPlan(..),Loan(..),Mortgage(..),AssetUnion(..),MixedAsset(..),FixedAsset(..) + ,AmortRule(..),Capacity(..),AssociateExp(..),AssociateIncome(..),ReceivableFeeType(..),Receivable(..) + ,ProjectedCashflow(..),Obligor(..),LeaseRateCalc(..) + ,calcAssetPrinInt, calcPmt + ) + where + +import Language.Haskell.TH +import GHC.Generics +import Data.Aeson.TH +import Data.Aeson.Types +--import Asset + +import Data.OpenApi hiding (Server,contentType) + +import Types hiding (Current,startDate,originTerm) +import Data.Ratio +import Data.Proxy +import Data.Decimal +import Util +import qualified Data.Map as Map +import qualified InterestRate as IR +import qualified Cashflow as CF +-- import Assumptions (RevolvingAssumption(Dummy4)) +import Control.Lens hiding (element,Index) +import Control.Lens.TH + +import Debug.Trace (trace) +debug = flip Debug.Trace.trace + + +type DailyRate = Balance + +data AmortPlan = Level -- ^ for mortgage / french system -> fixed payment each period which consist of increasing princial and decreasing interest. + | Even -- ^ for linear mortgage -> evenly distributed principal repayment + | I_P -- ^ interest only and principal due at last payment + | F_P -- ^ fee based + | PO_FirstN Int -- ^ 0 fee for first N period + | IO_FirstN Int AmortPlan -- ^ interest only for first N period + | NO_FirstN Int AmortPlan -- ^ non payment during first N period + | ScheduleRepayment Ts (Maybe DatePattern) -- ^ custom principal follow + | Balloon Int -- ^ balloon payment with period N + deriving (Show, Generic, Ord, Eq) + +-- | calculate period payment (Annuity/Level mortgage) +calcPmt :: Balance -> IRate -> Int -> Amount +calcPmt bal rate periods | rate == 0.0 = divideBI bal periods + | otherwise = + let rate' = realToFrac rate :: Double + logBase = log (1 + rate') + num = exp (logBase * fromIntegral periods) + den = num - 1 + r1 = num / den + in mulBR (realToFrac bal) (toRational (rate' * r1)) + +type InterestAmount = Balance +type PrincipalAmount = Balance + +calcAssetPrinInt :: AmortPlan -> Balance -> IRate -> Int -> Int -> (Balance,Int) -> (InterestAmount, PrincipalAmount) +calcAssetPrinInt pt bal rate ot rt (amortBal, amortTerm) = + let + interestAccrued = mulBIR bal rate + pmt = calcPmt bal rate rt + periodPassed = ot - rt + in + case pt of + Level -> (interestAccrued, pmt - interestAccrued) + Even -> (interestAccrued, bal / fromIntegral rt) + I_P -> if rt == 1 then + (interestAccrued, bal) + else + (interestAccrued, 0) + NO_FirstN n _pt -> if periodPassed >= n then + calcAssetPrinInt _pt bal rate ot rt (amortBal, amortTerm) + else + (0, negate interestAccrued) + IO_FirstN n _pt -> if periodPassed >= n then + calcAssetPrinInt _pt bal rate ot rt (amortBal, amortTerm) + else + (interestAccrued, 0) + + Balloon n -> if rt == 1 then + (interestAccrued, bal) + else + let + bPmt = calcPmt bal rate (amortTerm - periodPassed) -- `debug` ("Amort term"++show (amortTerm - periodPassed) <> " rt"++show periodPassed) + in + (interestAccrued, bPmt - interestAccrued) -- `debug` ("bal"++show bal++"rate"++show rate++"ot"++show ot++"rt"++show rt++"bPmt"++show bPmt++ "interest"++show interestAccrued) + + _ -> error $ "unsupported pt "++ show pt + + +data Status = Current + | Defaulted (Maybe Date) + -- | Delinquency (Maybe Int) + -- | Extended (Maybe T.Day) + deriving (Show,Generic,Ord,Eq) + +data PrepayPenaltyType = ByTerm Int Rate Rate -- ^ using penalty rate 1 if period < Int, use penalty rate 2 if period > Int + | FixAmount Balance (Maybe Int) -- ^ fixed penalty fee if any prepayment, or it only applies if period < Int + | FixPct Rate (Maybe Int) -- ^ fixed percentage penalty fee as percentage of prepayment, or it only applies if period < Int + | Sliding Rate Rate -- ^ starting with Rate1 at period 1 then decrease by step by rate2 + | StepDown [(Int,Rate)] -- ^ first tuple (n,r) ,first n periods use penalty rate r , then next n periods use pentaly rate in next tuple + -- | NMonthInterest Int + deriving (Show,Generic,Eq,Ord) + +data AmortRule = DecliningBalance -- ^ DecliningBalance Method + | StraightLine -- ^ Straight Line Method + deriving (Show,Generic,Eq,Ord) + +data ReceivableFeeType = FixedFee Balance -- ^ a flat fee amount + | FixedRateFee Rate -- ^ a percentage fee against balance for once + | FactorFee Rate Int Direction -- ^ a percentage fee against balance for each period (N days) + | AdvanceFee Rate -- ^ annualized rate for discount fee based on advance amount + | CompoundFee [ReceivableFeeType] -- ^ compound fee + deriving (Show,Generic,Eq,Ord) + + +data Obligor = Obligor {obligorId :: String + , obligorTag :: [String] + , obligorFields :: Map.Map String (Either String Double) + } deriving (Show,Generic,Eq,Ord) + +data LeaseRateCalc = ByDayRate DailyRate DatePattern + | ByPeriodRental Balance Period + deriving (Show,Generic,Eq,Ord) + + +data OriginalInfo = MortgageOriginalInfo { originBalance :: Balance + ,originRate :: IR.RateType + ,originTerm :: Int + ,period :: Period + ,startDate :: Date + ,prinType :: AmortPlan + ,prepaymentPenalty :: Maybe PrepayPenaltyType + ,obligor :: Maybe Obligor } + | LoanOriginalInfo { originBalance :: Balance + ,originRate :: IR.RateType + ,originTerm :: Int + ,period :: Period + ,startDate :: Date + ,prinType :: AmortPlan + ,obligor :: Maybe Obligor } + | LeaseInfo { startDate :: Date -- ^ lease start date + ,originTerm :: Int -- ^ total terms + ,originRental :: LeaseRateCalc -- ^ rental by day + ,obligor :: Maybe Obligor } + | FixedAssetInfo { startDate :: Date + ,originBalance :: Balance + ,residualBalance :: Balance + ,originTerm :: Int + ,period :: Period + ,accRule :: AmortRule + ,capacity :: Capacity } + | ReceivableInfo { startDate :: Date + ,originBalance :: Balance + ,originAdvance :: Balance + ,dueDate :: Date + ,feeType :: Maybe ReceivableFeeType + ,obligor :: Maybe Obligor } + deriving (Show,Generic,Ord,Eq) + + +data Installment = Installment OriginalInfo Balance RemainTerms Status + | Dummy + deriving (Show,Generic,Ord,Eq) + +data LeaseStepUp = FlatRate Rate + | ByRateCurve [Rate] + | ByFlatAmount Balance + | ByAmountCurve [Balance] + deriving (Show,Generic,Ord,Eq) + +data Lease = RegularLease OriginalInfo Balance RemainTerms Status + | StepUpLease OriginalInfo LeaseStepUp Balance RemainTerms Status + deriving (Show,Generic,Eq,Ord) + +data AccrualPeriod = AccrualPeriod Date DailyRate + deriving (Show,Generic,Eq,Ord) + +instance TimeSeries AccrualPeriod where + getDate (AccrualPeriod d _) = d + +data Loan = PersonalLoan OriginalInfo Balance IRate RemainTerms Status + | DUMMY + deriving (Show,Generic,Ord,Eq) + +data Mortgage = Mortgage OriginalInfo Balance IRate RemainTerms (Maybe BorrowerNum) Status + | AdjustRateMortgage OriginalInfo IR.ARM Balance IRate RemainTerms (Maybe BorrowerNum) Status + | ScheduleMortgageFlow Date [CF.TsRow] DatePattern + deriving (Show,Generic,Eq,Ord) + + +type FixRatePortion = (Rate, IRate) +type FloatRatePortion = (Rate, Spread, Index) + + +data ProjectedCashflow = ProjectedFlowFixed CF.CashFlowFrame DatePattern + | ProjectedFlowMixFloater CF.CashFlowFrame DatePattern FixRatePortion [FloatRatePortion] + deriving (Show,Generic,Eq,Ord) + + +data Receivable = Invoice OriginalInfo Status + | DUMMY4 + deriving (Show,Generic,Eq,Ord) + +data MixedAsset = MixedPool (Map.Map String [AssetUnion]) + | DUMMY2 + deriving (Show,Generic,Eq,Ord) + +type LineOfCredit = Maybe Balance + +data Revolver = Heloc OriginalInfo LineOfCredit Balance IRate RemainTerms (Maybe BorrowerNum) Status + | DUMMY5 + deriving (Show,Generic,Eq,Ord) + +-- FixedAsset +data Capacity = FixedCapacity Balance + | CapacityByTerm [(Int,Balance)] + deriving (Show,Generic,Ord,Eq) + +data AssociateExp = ExpPerPeriod Balance + | ExpPerUnit Balance + deriving (Show,Generic,Ord,Eq) + +data AssociateIncome = IncomePerPeriod Balance + | IncomePerUnit Balance + deriving (Show,Generic,Ord,Eq) + +data FixedAsset = FixedAsset OriginalInfo Balance RemainTerms + | Dummy5 + deriving (Show,Generic,Eq,Ord) + + +-- Base type to hold all asset types +data AssetUnion = MO Mortgage + | LO Loan + | IL Installment + | LS Lease + | FA FixedAsset + | RE Receivable + | PF ProjectedCashflow + deriving (Show, Generic,Ord,Eq) + + +instance IR.UseRate AssetUnion where + getIndex (MO ma) = IR.getIndex ma + getIndex (LO ma) = IR.getIndex ma + getIndex (IL ma) = IR.getIndex ma + getIndex (LS ma) = IR.getIndex ma + getIndex (FA ma) = IR.getIndex ma + getIndex (RE ma) = IR.getIndex ma + getIndex (PF ma) = IR.getIndex ma + + +instance IR.UseRate Mortgage where + getIndex (Mortgage oi@MortgageOriginalInfo{ originRate = IR.Floater _ idx _ _ _ _ _ _ } _ _ _ _ _) = Just idx + getIndex Mortgage {} = Nothing + getIndex (AdjustRateMortgage oi@MortgageOriginalInfo{ originRate = IR.Floater _ idx _ _ _ _ _ _ } _ _ _ _ _ _) = Just idx + getIndex AdjustRateMortgage {} = Nothing + +instance IR.UseRate Loan where + getIndex (PersonalLoan oi@LoanOriginalInfo{originRate = IR.Floater _ idx _ _ _ _ _ _ } _ _ _ _) = Just idx + getIndex PersonalLoan {} = Nothing + +instance IR.UseRate Installment where + getIndex (Installment oi@LoanOriginalInfo{originRate = IR.Floater _ idx _ _ _ _ _ _ } _ _ _) = Just idx + getIndex Installment {} = Nothing + +instance IR.UseRate Lease where + getIndex :: Lease -> Maybe Index + getIndex _ = Nothing + +instance IR.UseRate FixedAsset where + getIndex _ = Nothing + +instance IR.UseRate Receivable where + getIndex _ = Nothing + +instance IR.UseRate ProjectedCashflow where + getIndex (ProjectedFlowFixed cf _) = Nothing + + getIndex (ProjectedFlowMixFloater cf _ _ (f:fs)) = Just $ (\(a,b,c) -> c) f + getIndexes (ProjectedFlowMixFloater cf _ _ fs ) + = Just $ (\(a,b,c) -> c) <$> fs + + +$(concat <$> traverse (deriveJSON defaultOptions) [''Obligor, ''OriginalInfo, ''FixedAsset, ''AmortPlan, ''PrepayPenaltyType + , ''Capacity, ''AmortRule, ''ReceivableFeeType, ''LeaseRateCalc]) + + +makePrisms ''OriginalInfo + +$(deriveJSON defaultOptions ''AssociateExp) +$(deriveJSON defaultOptions ''AssociateIncome) +$(deriveJSON defaultOptions ''Status) +$(deriveJSON defaultOptions ''Installment) +$(deriveJSON defaultOptions ''LeaseStepUp) +$(deriveJSON defaultOptions ''Mortgage) +$(deriveJSON defaultOptions ''Loan) +$(deriveJSON defaultOptions ''Lease) +$(deriveJSON defaultOptions ''Receivable) +$(deriveJSON defaultOptions ''ProjectedCashflow) +$(deriveJSON defaultOptions ''AssetUnion) +instance ToSchema Capacity +instance ToSchema AmortRule +instance ToSchema (Ratio Integer) where + declareNamedSchema _ = NamedSchema Nothing <$> declareSchema (Proxy :: Proxy Double) + +instance ToSchema (Decimal) where + declareNamedSchema _ = NamedSchema Nothing <$> declareSchema (Proxy :: Proxy Double) + +instance ToSchema PrepayPenaltyType +instance ToSchema (TsPoint Int) +instance ToSchema Ts +instance ToSchema (TsPoint Balance) +instance ToSchema (TsPoint IRate) +instance ToSchema (TsPoint Rational) +instance ToSchema (TsPoint Bool) +instance ToSchema (RoundingBy IRate) +instance ToSchema Obligor +instance ToSchema Index +instance ToSchema DayCount +instance ToSchema Direction +instance ToSchema AmortPlan +instance ToSchema CutoffType +instance ToSchema DatePattern +instance ToSchema IR.RateType +instance ToSchema CF.TsRow +instance ToSchema Period +instance ToSchema IR.ARM +instance ToSchema Status +instance ToSchema ReceivableFeeType +instance ToSchema LeaseRateCalc +instance ToSchema OriginalInfo +instance ToSchema Mortgage diff --git a/src/AssetClass/AssetCashflow.hs b/src/AssetClass/AssetCashflow.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/AssetCashflow.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module AssetClass.AssetCashflow + (applyHaircut,patchPrepayPenaltyFlow,getRecoveryLag,decreaseBorrowerNum + ,patchLossRecovery,getRecoveryLagFromAssumption) + where + +import qualified Data.Time as T +import qualified Cashflow as CF +import Types +import Lib +import Util +import DateUtil +import InterestRate as IR + +import qualified Data.Map as Map +import Data.List +import Data.Ratio +import Data.Maybe +import GHC.Generics +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types + +import AssetClass.AssetBase + +import Debug.Trace +import qualified Assumptions as A +import GHC.Float.RealFracMethods (truncateFloatInteger) +import Cashflow (mflowDefault) +debug = flip trace + +-- This module is a collection of common cashflow functions to project cashflow for different asset types. + +-- ^ apply haircut to pool cashflow, reduce cash via a percentage +applyHaircut :: Maybe A.ExtraStress -> CF.CashFlowFrame -> CF.CashFlowFrame +applyHaircut Nothing cf = cf +applyHaircut (Just A.ExtraStress{A.poolHairCut = Nothing}) cf = cf +applyHaircut (Just A.ExtraStress{A.poolHairCut = Just haircuts}) (CF.CashFlowFrame st txns) + = CF.CashFlowFrame st $ + (\txn -> foldr + (\fn acc -> fn acc ) + txn + (applyHaircutTxn <$> haircuts) ) <$> txns + where + applyHaircutTxn (CollectedInterest,r) + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn mst) + = CF.MortgageDelinqFlow d bal prin (mulBR interest (1-r)) ppy delinq def recovery loss irate mbn mppn mst + applyHaircutTxn (CollectedPrincipal,r) + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn mst) + = CF.MortgageDelinqFlow d bal (mulBR prin (1-r)) interest ppy delinq def recovery loss irate mbn mppn mst + applyHaircutTxn (CollectedRecoveries,r) + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn mst) + = CF.MortgageDelinqFlow d bal prin interest ppy delinq def (mulBR recovery (1-r)) loss irate mbn mppn mst + applyHaircutTxn (CollectedPrepayment,r) + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn mst) + = CF.MortgageDelinqFlow d bal prin interest (mulBR ppy (1-r)) delinq def recovery loss irate mbn mppn mst + applyHaircutTxn (CollectedPrepaymentPenalty,r) + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn mst) + = CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn ((\x -> mulBR x (1-r) ) <$> mppn) mst + + applyHaircutTxn (CollectedInterest,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn mst) + = CF.MortgageFlow d bal prin (mulBR interest (1-r)) ppy def recovery loss irate mbn mppn mst + applyHaircutTxn (CollectedPrincipal,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn mst) + = CF.MortgageFlow d bal (mulBR prin (1-r)) interest ppy def recovery loss irate mbn mppn mst + applyHaircutTxn (CollectedRecoveries,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn mst) + = CF.MortgageFlow d bal prin interest ppy def (mulBR recovery (1-r)) loss irate mbn mppn mst + applyHaircutTxn (CollectedPrepayment,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn mst) + = CF.MortgageFlow d bal prin interest (mulBR ppy (1-r)) def recovery loss irate mbn mppn mst + applyHaircutTxn (CollectedPrepaymentPenalty,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn mst) + = CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn ((\x -> mulBR x (1-r) ) <$> mppn) mst + + applyHaircutTxn _ _ = error "Not implemented" + +-- ^ apply a penalty cashflow +patchPrepayPenaltyFlow :: (Int,Maybe PrepayPenaltyType) -> CF.CashFlowFrame -> CF.CashFlowFrame +patchPrepayPenaltyFlow (ot,mPpyPen) mflow@(CF.CashFlowFrame st trs) + = let + --(startDate,endDate) = CF.getDateRangeCashFlowFrame mflow + prepaymentFlow = CF.mflowPrepayment <$> trs + flowSize = CF.sizeCashFlowFrame mflow + in + case mPpyPen of + Nothing -> mflow + Just (ByTerm cutoff rate0 rate1) -> + let + rs = lastN flowSize $ replicate cutoff rate0 ++ replicate (ot-cutoff) rate1 + in + CF.CashFlowFrame st $ CF.setPrepaymentPenaltyFlow (zipWith mulBR prepaymentFlow rs) trs + Just (FixAmount amt mCutoff) -> + let + projFlow = case mCutoff of + Nothing -> replicate flowSize amt + Just cutoff -> lastN flowSize $ replicate cutoff amt ++ replicate (ot-cutoff) 0 + actFlow = [ if ppy > 0 then + f + else + 0 + | (f,ppy) <- zip projFlow prepaymentFlow] + in + CF.CashFlowFrame st $ CF.setPrepaymentPenaltyFlow actFlow trs + Just (FixPct r mCutoff) -> + let + rs = case mCutoff of + Nothing -> replicate flowSize r + Just cutoff -> lastN flowSize $ replicate cutoff r ++ replicate (ot-cutoff) 0 + in + CF.CashFlowFrame st $ CF.setPrepaymentPenaltyFlow (zipWith mulBR prepaymentFlow rs) trs + Just (Sliding sr changeRate) -> + let + rs = lastN flowSize $ paddingDefault 0 (0:[sr,(sr-changeRate)..0]) ot + in + CF.CashFlowFrame st $ CF.setPrepaymentPenaltyFlow (zipWith mulBR prepaymentFlow rs) trs + Just (StepDown ps) -> + let + rs = lastN flowSize $ paddingDefault 0 (concat [ replicate n r | (n,r) <- ps]) ot + in + CF.CashFlowFrame st $ CF.setPrepaymentPenaltyFlow (zipWith mulBR prepaymentFlow rs) trs + +getRecoveryLag :: A.RecoveryAssumption -> Int +getRecoveryLag (A.Recovery (_,lag)) = lag +getRecoveryLag (A.RecoveryTiming (_,rs)) = length rs + +getRecoveryLagFromAssumption :: A.AssetPerfAssumption -> Maybe Int +getRecoveryLagFromAssumption (A.MortgageAssump _ _ (Just ra) _) = Just $ getRecoveryLag ra +getRecoveryLagFromAssumption (A.MortgageDeqAssump _ _ (Just ra) _) = Just $ getRecoveryLag ra +getRecoveryLagFromAssumption (A.LoanAssump _ _ (Just ra) _) = Just $ getRecoveryLag ra +getRecoveryLagFromAssumption (A.InstallmentAssump _ _ (Just ra) _) = Just $ getRecoveryLag ra +getRecoveryLagFromAssumption (A.ReceivableAssump _ (Just ra) _) = Just $ getRecoveryLag ra +getRecoveryLagFromAssumption _ = Nothing + + +decreaseBorrowerNum :: Balance -> Balance -> Maybe BorrowerNum -> Maybe Int +decreaseBorrowerNum bb 0 mBn = Nothing +decreaseBorrowerNum bb eb mBn + = case mBn of + Nothing -> Nothing::(Maybe BorrowerNum) + Just 0 -> Nothing::(Maybe BorrowerNum) + Just bn -> Just $ round $ fromRational $ mulIR bn downRate::(Maybe BorrowerNum) + where + downRate = if eb == 0 then + 0.0 + else + divideBB eb bb + +-- | given a list of future cashflows and patch recovery & loss +patchLossRecovery :: [CF.TsRow] -> Maybe A.RecoveryAssumption -> [CF.TsRow] +patchLossRecovery trs Nothing + = CF.dropTailEmptyTxns $ [ CF.tsSetRecovery 0 (CF.tsSetLoss d r) | (d,r) <- zip defaultVec trs ] -- `debug` ("Hit Nothign on recovery"++ show defaultVec) + where + defaultVec = mflowDefault <$> trs + +-- ^ make sure trs has empty rows with length=lag. as it drop extended rows +patchLossRecovery trs (Just (A.Recovery (rr,lag))) + = CF.dropTailEmptyTxns $ [ CF.tsSetRecovery recovery (CF.tsSetLoss loss r) | (r,recovery,loss) <- zip3 trs recoveryAfterLag lossVecAfterLag] + where + defaultVec = mflowDefault <$> trs + recoveriesVec = (`mulBR` rr) <$> defaultVec -- `debug` ("Default Vec"++ show defaultVec) + recoveryAfterLag = replicate lag 0.0 ++ recoveriesVec -- `debug` ("recovery"++ show recoveriesVec) + lossVec = (`mulBR` (1-rr)) <$> defaultVec -- `debug` ("Rec after lag"++ show recoveryAfterLag) + lossVecAfterLag = replicate lag 0.0 ++ lossVec -- drop last lag elements + +patchLossRecovery trs (Just (A.RecoveryTiming (rr,recoveryTimingDistribution))) + = CF.dropTailEmptyTxns $ [ CF.tsSetRecovery recVal (CF.tsSetLoss loss r) | (recVal,loss,r) <- zip3 sumRecovery sumLoss trs ] + where + cfLength = length trs -- cashflow length + rLength = length recoveryTimingDistribution -- recovery length + defaultVec = mflowDefault <$> trs -- default balance of each row + + rs = (rr *) <$> recoveryTimingDistribution + + recoveriesVec = [ mulBR defaultVal <$> rs | defaultVal <- defaultVec ] + + offsets = [0..(length defaultVec - rLength)] + + paddedRecoveries = [ paddingDefault 0 (replicate prePadding 0 ++ recVal) cfLength + | (prePadding,recVal) <- zip offsets recoveriesVec ] + + sumRecovery = sum <$> transpose paddedRecoveries + lossVec = [ mulBR defaultVal (1-rr) | defaultVal <- defaultVec ] + sumLoss = replicate (pred rLength) 0.0 ++ lossVec diff --git a/src/AssetClass/FixedAsset.hs b/src/AssetClass/FixedAsset.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/FixedAsset.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE InstanceSigs #-} + +module AssetClass.FixedAsset + () + where + +import qualified Data.Time as T +import Data.Ratio + +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Maybe +import Data.List +import Data.Aeson.TH +import qualified Data.Map as Map +import Data.Aeson.Types +import GHC.Generics + +import qualified Assumptions as A +import Types hiding (startDate) +import Lib +import Util +import DateUtil +import qualified Cashflow as CF + +import AssetClass.AssetBase + + +import Debug.Trace +import AssetClass.AssetCashflow +import qualified Asset as Ast +import Asset (Asset(projCashflow)) +import Assumptions (AssetDelinqPerfAssumption(DummyDelinqAssump)) +debug = flip trace + + +-- life time schedule amortization amount list +calcAmortAmt ::FixedAsset -> Either String [Balance] +calcAmortAmt fa@(FixedAsset fai@FixedAssetInfo{originBalance=ob, accRule=ar, originTerm=ot + ,residualBalance=rb ,capacity=cap} b rt) + = case ar of + StraightLine -> Right $ replicate ot $ divideBI (b-rb) rt + DecliningBalance -> + let + amortizeRate = realToFrac $ 2 % ot + futureBals' = scaleByFstElement b $ lastN (succ rt) $ scanl (\acc r -> acc * (1 - r)) ob (replicate ot amortizeRate) + -- straigh lines + futureBals'' = scanl + (\acc (bal',amt',rt') -> + (acc - (max amt' (divideBI (acc - rb) (rt - rt')))) + ) + (head futureBals') + (zip3 futureBals' (diffNum futureBals') [0..succ rt]) + in + Right (diffNum futureBals'') + + _ -> Left ("Not implemented for depreciation rule"++show ar) + +calcAmortBals ::FixedAsset -> Either String [Balance] +calcAmortBals fa@(FixedAsset fai@FixedAssetInfo{originBalance=ob, accRule=ar, originTerm=ot + ,residualBalance=rb ,capacity=cap} b rt) + = do + bals <- calcAmortAmt fa + return $ scanl (-) ob bals + + +instance Ast.Asset FixedAsset where + + calcCashflow fa@(FixedAsset {}) asOfDay _ = + fst <$> projCashflow fa asOfDay (A.FixedAssetAssump (mkTs []) (mkTs []) Nothing, A.DummyDelinqAssump, A.DummyDefaultAssump) Nothing + + getCurrentBal fa@(FixedAsset fai@FixedAssetInfo{originBalance=ob, accRule=ar, originTerm=ot + ,residualBalance=rb ,capacity=cap} curBal rt) + = curBal + + resetToOrig fa@(FixedAsset fai@FixedAssetInfo{originBalance=ob, accRule=ar, originTerm=ot + ,residualBalance=rb ,capacity=cap} b rt) + = FixedAsset fai b ot + + getPaymentDates + (FixedAsset fo@FixedAssetInfo{startDate=sd ,period=p,originTerm=ot} _ rt) + extra + = genDates sd p (ot+extra) + + projCashflow fa@(FixedAsset fai@FixedAssetInfo{originBalance=ob, accRule=ar, originTerm=ot + ,residualBalance=rb ,capacity=cap} curBalance rt) + asOfDay + (A.FixedAssetAssump uCurve pCurve mExtPeriods,_,_) + _ + = let + extPeriods = fromMaybe 0 mExtPeriods + cfLength = rt + extPeriods + pdates = lastN cfLength $ Ast.getPaymentDates fa extPeriods + capacityCaps = case cap of + FixedCapacity b -> replicate cfLength b + CapacityByTerm tbl -> lastN cfLength $ concat [ replicate i b | (i,b) <- tbl ] ++ (replicate extPeriods (snd (last tbl))) + + utilsVec = getValByDates uCurve Inc pdates + units = [ mulBR c u | (u,c) <- zip utilsVec capacityCaps] + prices = getValByDates pCurve Inc pdates + cash = [ mulBR u p | (p,u) <- zip prices units] + in + do + scheduleAmt <- calcAmortAmt fa + let amortizedBals = lastN cfLength $ scheduleAmt ++ replicate extPeriods 0 + let scheduleBals = tail $ scanl (-) curBalance (amortizedBals ++ [0]) + let cumuDep = ob - curBalance + let cumuDepreciation = tail $ scanl (+) cumuDep amortizedBals + let txns = zipWith6 CF.FixedFlow pdates scheduleBals amortizedBals cumuDepreciation units cash + let futureTxns = cutBy Inc Future asOfDay txns + let begBal = CF.buildBegBal futureTxns + return $ (CF.CashFlowFrame (begBal,asOfDay,Nothing) $ futureTxns, Map.empty) diff --git a/src/AssetClass/Installment.hs b/src/AssetClass/Installment.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/Installment.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module AssetClass.Installment + (projectInstallmentFlow, updateOriginDate) + where + +import qualified Data.Time as T +import Data.Ratio + +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Maybe +import Data.List +import qualified Data.DList as DL +import Data.Aeson.TH +import qualified Data.Map as Map +import Data.Aeson.Types +import GHC.Generics + +import Asset +import InterestRate +import qualified Assumptions as A +import Types +import Lib +import Util +import DateUtil +import qualified Cashflow as CF + +import AssetClass.AssetBase + +import Debug.Trace +import AssetClass.AssetCashflow +import qualified Asset as Ast +import Control.Lens hiding (element) +import Control.Lens.TH +debug = flip trace + + +projectInstallmentFlow :: (Balance,Date,(Balance,Balance),IRate,Rational,AmortPlan,Int) -> (Dates, [DefaultRate], [PrepaymentRate], [Int]) -> (DL.DList CF.TsRow, Balance ,Rational) +projectInstallmentFlow (startBal, lastPaidDate, (originRepay,originInt), startRate,begFactor,pt,ot) (cfDates, defRates, ppyRates, remainTerms) + = let + initRow = CF.LoanFlow lastPaidDate startBal 0.0 0.0 0.0 0.0 0.0 0.0 startRate Nothing + calcPrin _rt _bal _opmt _factor = case _rt of + 1 -> _bal + 0 -> 0 + _ -> mulBR _opmt _factor + in + foldl + (\(acc,begBal,factor) (pDate, ppyRate, defRate, rt) -> + let + -- begBal = view CF.tsRowBalance (last acc) + newDefault = mulBR begBal defRate + newPrepay = mulBR (begBal - newDefault) ppyRate + intBal = begBal - newDefault - newPrepay + newFactor = factor * (1-defRate) * (1- ppyRate) + newInt = case pt of + F_P -> if rt > 0 then + mulBR originInt newFactor + else + 0 + PO_FirstN n -> if (ot-rt) >= n then + mulBR originInt newFactor + else + 0 + newPrin = calcPrin rt intBal originRepay newFactor + endBal = intBal - newPrin + in + (DL.snoc acc (CF.LoanFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0 startRate Nothing) + ,endBal + ,newFactor)) + (DL.singleton initRow, startBal, begFactor) + (zip4 cfDates ppyRates defRates remainTerms) + + +instance Asset Installment where + calcCashflow inst@(Installment (LoanOriginalInfo ob or ot p sd ptype _) cb rt st) asOfDay _ + = Right $ CF.CashFlowFrame (begBal,asOfDay,Nothing) flows + where + lastPayDate:cf_dates = lastN (rt+1) $ sd:getPaymentDates inst 0 + opmt = divideBI ob ot + schedule_balances = scanl (-) ob (replicate ot opmt) + current_schedule_bal = schedule_balances !! (ot - rt) + ofee = mulBIR ob (getOriginRate inst) + + factor = cb / current_schedule_bal + cpmt = opmt * factor + cfee = ofee * factor + orate = getOriginRate inst + + stressed_bal_flow = map (* factor) $ lastN rt schedule_balances + prin_flow = replicate rt cpmt + int_flow = case ptype of + F_P -> replicate rt cfee + PO_FirstN n -> lastN rt $ replicate n 0.0 ++ replicate (ot-n) cfee + -- initRow = CF.LoanFlow lastPayDate cb 0.0 0.0 0.0 0.0 0.0 0.0 0.0 Nothing + _flows = let + _rt = succ rt + in + zipWith10 CF.LoanFlow (lastPayDate:cf_dates) (cb:stressed_bal_flow) (0:prin_flow) (0:int_flow) + (replicate _rt 0.0) (replicate _rt 0.0) (replicate _rt 0.0) (replicate _rt 0.0) + (replicate _rt orate) (replicate _rt Nothing) + + flows = cutBy Inc Future asOfDay _flows + begBal = CF.buildBegBal flows + + + getCurrentBal (Installment _ b _ _ ) = b + getOriginInfo (Installment oi _ _ _) = oi + getOriginBal (Installment (LoanOriginalInfo ob _ _ _ _ _ _) _ _ _) = ob + + getOriginRate (Installment (LoanOriginalInfo _ or _ _ _ _ _) _ _ _) + = case or of + Fix _ _r -> _r + Floater _ _ _ _r _ _ _ _ -> _r + + isDefaulted (Installment _ _ _ (Defaulted _)) = True + isDefaulted (Installment {}) = False + + getPaymentDates (Installment (LoanOriginalInfo _ _ ot p sd _ _) _ _ _) extra + = genDates sd p (ot+extra) + + getOriginDate (Installment (LoanOriginalInfo _ _ ot p sd _ _) _ _ _) = sd + + getRemainTerms (Installment (LoanOriginalInfo _ _ ot p sd _ _) _ rt _) = rt + + updateOriginDate (Installment (LoanOriginalInfo ob or ot p sd _type _obligor) cb rt st) nd + = Installment (LoanOriginalInfo ob or ot p nd _type _obligor) cb rt st + + resetToOrig (Installment (LoanOriginalInfo ob or ot p sd _type _obligor) cb rt st) + = Installment (LoanOriginalInfo ob or ot p sd _type _obligor) ob ot st + + projCashflow inst@(Installment (LoanOriginalInfo ob or ot p sd pt _) cb rt Current) + asOfDay + pAssump@(A.InstallmentAssump defaultAssump prepayAssump recoveryAssump ams,_,_) + mRates + = let + recoveryLag = maybe 0 getRecoveryLag recoveryAssump + lastPayDate:cfDates = lastN (rt + recoveryLag +1) $ sd:getPaymentDates inst recoveryLag + + opmt = divideBI ob ot + orate = getOriginRate inst + ofee = mulBIR ob orate + + remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt] + + scheduleBalances = scanl (-) ob (replicate ot opmt) + currentScheduleBal = scheduleBalances !! (ot - rt) -- `debug` ("RT->"++show rt) + currentFactor = divideBB cb currentScheduleBal + in + do + ppyRates <- Ast.buildPrepayRates inst (lastPayDate:cfDates) prepayAssump + defRates <- Ast.buildDefaultRates inst (lastPayDate:cfDates) defaultAssump + let (txns,_,_) = projectInstallmentFlow (cb,lastPayDate,(opmt,ofee),orate,currentFactor,pt,ot) (cfDates,defRates,ppyRates,remainTerms) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery (DL.toList txns) recoveryAssump) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM) + + -- ^ project with defaulted at a date + projCashflow inst@(Installment (LoanOriginalInfo ob or ot p sd ptype _) cb rt (Defaulted (Just defaultedDate))) + asOfDay + (_,_,(A.DefaultedRecovery rr lag timing)) + mRates + = let + (cf_dates1,cf_dates2) = splitAt lag $ genDates defaultedDate p (lag+length timing) + beforeRecoveryTxn = [ CF.LoanFlow d cb 0 0 0 0 0 0 cr Nothing | d <- cf_dates1 ] + recoveries = calcRecoveriesFromDefault cb rr timing + bals = scanl (-) cb recoveries + _txns = [ CF.LoanFlow d b 0 0 0 0 r 0 cr Nothing | (b,d,r) <- zip3 bals cf_dates2 recoveries ] + futureTxns = cutBy Inc Future asOfDay $ beforeRecoveryTxn++_txns + begBal = CF.buildBegBal futureTxns + in + Right $ (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns ,Map.empty) + where + cr = getOriginRate inst + + -- ^ project cashflow with defaulted status + projCashflow inst@(Installment _ cb rt (Defaulted Nothing)) asOfDay assumps _ + = Right $ (CF.CashFlowFrame (cb, asOfDay, Nothing) $ [CF.LoanFlow asOfDay cb 0 0 0 0 0 0 (getOriginRate inst) Nothing],Map.empty) + + projCashflow a b c d = Left $ "Failed to match when proj mortgage with assumption >>" ++ show a ++ show b ++ show c ++ show d + + splitWith (Installment (LoanOriginalInfo ob or ot p sd _type _obligor) cb rt st) rs + = [ Installment (LoanOriginalInfo (mulBR ob ratio) or ot p sd _type _obligor) (mulBR cb ratio) rt st | ratio <- rs ] + + diff --git a/src/AssetClass/Lease.hs b/src/AssetClass/Lease.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/Lease.hs @@ -0,0 +1,345 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module AssetClass.Lease + (Lease(..),projCashflow,updateOriginDate) + where + +import qualified Data.Time as T +import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) +import qualified Assumptions as AP +import Asset +import Types hiding (getOriginDate) +import Lib +import Util +import DateUtil + +import qualified Data.Map as Map +import Data.List +import Data.Aeson hiding (json) +import Data.Decimal +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import GHC.Generics +import Data.Maybe +import AssetClass.AssetBase +import qualified Analytics as AN + +import Control.Lens hiding (element) +import Control.Lens.TH + +import Debug.Trace +import qualified Assumptions as A +debug = flip trace + +type PeriodAmount = Balance +type CapRate = Rate +type RentChangeRate = Rate +type RentChangeCurve = Ts +type TermChangeRate = Rate +type DayGap = Int +type LastAccuredDate = Date + + +getNewRental :: AP.LeaseAssetRentAssump -> Date -> Date -> LeaseRateCalc -> (AP.LeaseAssetRentAssump, LeaseRateCalc) +-- by day rate +getNewRental (AP.BaseAnnualRate r) sd ed (ByDayRate dr dp) + = (AP.BaseAnnualRate r + , ByDayRate (mulBR dr (1 + yearCountFraction DC_ACT_365F sd ed * fromRational r)) dp) +getNewRental (AP.BaseCurve rc) sd ed (ByDayRate dr dp) + = (AP.BaseCurve rc + , ByDayRate (mulBR dr (1 + yearCountFraction DC_ACT_365F sd ed * getValByDate rc Exc ed)) dp) +getNewRental (AP.BaseByVec rs) sd ed (ByDayRate dr dp) + = let + (newDr,nextRs) = case Data.List.uncons rs of + Just (r,_rs) -> (mulBR dr (1 + yearCountFraction DC_ACT_365F sd ed * fromRational r) + , _rs) + Nothing -> (dr,[0.0]) + in + (AP.BaseByVec nextRs, ByDayRate newDr dp) + +-- by period rental +getNewRental (AP.BaseAnnualRate r) sd ed (ByPeriodRental rental per) + = (AP.BaseAnnualRate r + , ByPeriodRental (mulBR rental (1 + yearCountFraction DC_ACT_365F sd ed * fromRational r)) per) +getNewRental (AP.BaseCurve rc) sd ed (ByPeriodRental rental per) + = (AP.BaseCurve rc + , ByPeriodRental (mulBR rental (1 + yearCountFraction DC_ACT_365F sd ed * (fromRational (getValByDate rc Exc ed)))) per) +getNewRental (AP.BaseByVec rs) sd ed (ByPeriodRental rental per) + = let + (newRental,nextRs) = case Data.List.uncons rs of + Just (r,_rs) -> (mulBR rental (1 + yearCountFraction DC_ACT_365F sd ed * fromRational r) + , _rs) + Nothing -> (rental,[0.0]) + in + (AP.BaseByVec nextRs, ByPeriodRental newRental per) + +calcEndDate :: Date -> Int -> LeaseRateCalc -> Date +calcEndDate sd periods (ByDayRate _ dp) = last $ genSerialDates dp Exc sd periods +calcEndDate sd periods (ByPeriodRental _ per) = last $ genDates sd per periods + +calcGapDays :: AP.LeaseAssetGapAssump -> Date -> Int +calcGapDays (AP.GapDays days) _ = days +calcGapDays (AP.GapDaysByCurve ts) d = round $ fromRational $ getValByDate ts Exc d + +-- ^ Generate next lease with new rental / term changes/ day gap +nextLease :: Lease -> (AP.LeaseAssetRentAssump, TermChangeRate, DayGap) -> (Lease, Date ,(AP.LeaseAssetRentAssump, TermChangeRate, DayGap)) +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 + + nextOriginTerm = round $ mulIR ot (1+tc) + nextEndDate = calcEndDate nextStartDate ot rental + (newRassump, nextRental) = getNewRental rAssump sd nextStartDate rental + newBal = -1 + in + (RegularLease (LeaseInfo nextStartDate nextOriginTerm nextRental ob) + newBal nextOriginTerm Current + ,nextEndDate + ,(newRassump,tc,gd) + ) + +nextLease l@(StepUpLease (LeaseInfo sd ot rental ob) lsteupInfo bal rt _) (rAssump,tc,gd) + = let + leaseEndDate = last $ getPaymentDates l 0 + nextStartDate = T.addDays (succ (toInteger gd)) leaseEndDate -- `debug` ("Gap Day ->"++ show gd) + nextOriginTerm = round $ mulIR ot (1+tc) + nextEndDate = calcEndDate nextStartDate ot rental + (newRassump, nextRental) = getNewRental rAssump sd nextStartDate rental + newBal = -1 + in + (StepUpLease (LeaseInfo nextStartDate nextOriginTerm nextRental ob) + lsteupInfo newBal nextOriginTerm Current + ,nextEndDate + ,(newRassump,tc,gd) + ) -- `debug` ("leaseEndDate>>"++show leaseEndDate++">>>"++show (succ (toInteger gd))) + +-- | create a new lease base on the lease in 1st argument, with new rental/term, a gap days, till the end date +nextLeaseTill :: Lease -> (AP.LeaseAssetRentAssump, TermChangeRate, DayGap) -> Date -> AP.LeaseEndType -> [Lease] -> [Lease] +nextLeaseTill l (rsc,tc,mg) lastDate (AP.CutByDate ed) accum + | lastDate >= ed = accum + | otherwise = nextLeaseTill new_lease newAssump new_lastDate (AP.CutByDate ed) (accum++[new_lease]) + where + (new_lease,new_lastDate, newAssump) = nextLease l (rsc,tc,mg) + +nextLeaseTill l (rsc,tc,mg) lastDate (AP.StopByExtTimes n) accum + | n == 0 = accum + | otherwise = nextLeaseTill new_lease newAssump new_lastDate (AP.StopByExtTimes (pred n)) (accum++[new_lease]) + 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)) +calcPmts (ByFlatAmount _amt) fs amt = Right (scanl (+) amt (replicate (length fs) _amt)) +calcPmts (ByRateCurve rs) fs amt + | length rs /= length fs = Left "ByRateCurve: the rate curve should be the same length as remain pay dates" + | otherwise = Right $ scanl mulBR amt rs +calcPmts (ByAmountCurve amts) fs amt + | length amts /= length fs = Left "ByAmountCurve: the rate curve should be the same length as remain pay dates" + | otherwise = Right $ scanl (+) amt amts + +-- ^ return a lease contract with opening balance and a payment cashflow on each payment date +patchBalance :: Lease -> Either String (Lease,[Amount]) +patchBalance l@(RegularLease (LeaseInfo sd ot (ByDayRate dr dp) ob) bal rt st) + = let + cf_dates = sd:getPaymentDates l 0 + pmts = lastN rt $ [ fromRational (mulBInt dr ds) | ds <- getIntervalDays cf_dates ] + new_bal = sum pmts + in + Right (RegularLease (LeaseInfo sd ot (ByDayRate dr dp) ob) new_bal rt st, pmts) + +patchBalance l@(RegularLease (LeaseInfo sd ot (ByPeriodRental rental per) ob) bal rt st) + = let + -- cf_dates = lastN (succ rt) $ getPaymentDates l 0 + -- intervals = daysInterval cf_dates + pmts = lastN rt $ replicate ot rental + new_bal = sum pmts -- `debug` ("cf_date" ++ show cf_dates) + in + do + return (RegularLease (LeaseInfo sd ot (ByPeriodRental rental per) ob) new_bal rt st, pmts) -- `debug` ("daily payments" ++ show pmts) + + +patchBalance l@(StepUpLease (LeaseInfo sd ot (ByDayRate dr p) ob) lsu bal rt st) + = let + cfDates = sd:getPaymentDates l 0 + intervals = daysInterval cfDates + factors = replicate (pred ot) 1.0 + in + do + dailyRentals <- calcPmts lsu factors dr + let pmts = lastN rt $ [ fromRational (mulBInteger r d) | (d,r) <- zip intervals dailyRentals ] + let new_bal = sum pmts -- `debug` ("cf_date" ++ show cf_dates) + return (StepUpLease (LeaseInfo sd ot (ByDayRate dr p) ob) lsu new_bal rt st, pmts) -- `debug` ("daily payments" ++ show pmts) + +patchBalance l@(StepUpLease (LeaseInfo sd ot (ByPeriodRental rental per) ob) lsu bal rt st) + = let + factors = replicate (pred ot) 1.0 + in + do + periodRentals <- calcPmts lsu factors rental + let pmts = lastN rt periodRentals + let new_bal = sum pmts + return (StepUpLease (LeaseInfo sd ot (ByPeriodRental rental per) ob) lsu new_bal rt st, pmts) -- `debug` ("daily payments" ++ show pmts) + + +allocDefaultToLeaseFlow :: [Rate] -> (Rate,Balance) -> [CF.TsRow] -> [CF.TsRow] -> [CF.TsRow] +-- allocDefaultToLeaseFlow :: [Decimal] -> (Decimal,Decimal) -> [CF.TsRow] -> [CF.TsRow] -> [CF.TsRow] +allocDefaultToLeaseFlow defaultRates (begFactor,begBal) rs [] = reverse rs +allocDefaultToLeaseFlow (defaultRate:defaultRates) (begFactor,begBal) rs (txn@(CF.LeaseFlow d b r def):txns) + = let + defaultAmt = mulBR begBal defaultRate + nextFactor = begFactor * (1-defaultRate) + newRental = mulBR r nextFactor + rentalDiff = r - newRental + nextBal = (begBal - rentalDiff - newRental) -- TODO: hardcode to fix rounding issue + in + allocDefaultToLeaseFlow defaultRates (nextFactor,nextBal) ((CF.LeaseFlow d nextBal newRental rentalDiff):rs) txns + +calcDefaultRates :: Rate -> CF.CashFlowFrame -> [Rate] +calcDefaultRates r cf + = let + -- cfBegDate:cfDates = CF.getAllDatesCashFlowFrame cf + ds = CF.getAllDatesCashFlowFrame cf + in + Util.toPeriodRateByInterval r <$> getIntervalDays ds + +applyDefaults :: Maybe AP.LeaseDefaultType -> (CF.CashFlowFrame,[CF.CashFlowFrame]) -> ([CF.TsRow],[[CF.TsRow]]) +applyDefaults Nothing (CF.CashFlowFrame _ txn1,cfs) = (txn1,view CF.cashflowTxn <$> cfs) +-- applyDefaults (Just (AP.DefaultByContinuation r)) (CF.CashFlowFrame _ txn1,cfs) +-- = (txn1,(view CF.cashflowTxn) <$> cfs) +applyDefaults (Just (AP.DefaultByTermination r)) (cf1,cfs) + = let + cf1Factors = calcDefaultRates r cf1 + cfsFactors::[[Rate]] = calcDefaultRates r <$> cfs + in + (allocDefaultToLeaseFlow cf1Factors (1.0, (CF.getBegBalCashFlowFrame cf1)) [] (view CF.cashflowTxn cf1) + , (\(fs,cf) -> allocDefaultToLeaseFlow fs (1.0, (CF.getBegBalCashFlowFrame cf)) [] (view CF.cashflowTxn cf)) <$> (zip cfsFactors cfs) + ) + +applyDefaults (Just (AP.DefaultByContinuation r)) (cf1,cfs) + = let + cf1Defaults = calcDefaultRates r cf1 + cfsDefaults::[[Rate]] = calcDefaultRates r <$> cfs + + cf1Factor = foldr (*) 1.0 $ (1 -) <$> cf1Defaults + cfsFactors = (\df -> foldr (*) 1.0 ((1 -) <$> df)) <$> cfsDefaults + + cfFactors = cf1Factor : (init cfsFactors) + + cfs' = zipWith CF.splitCf cfsFactors cfs -- `debug` ("Cfs"++ show (cfsFactors)) + in + (allocDefaultToLeaseFlow cf1Defaults (1.0, (CF.getBegBalCashFlowFrame cf1)) [] (view CF.cashflowTxn cf1) + , (\(fs,cf) -> allocDefaultToLeaseFlow fs (1.0, (CF.getBegBalCashFlowFrame cf)) [] (view CF.cashflowTxn cf)) <$> (zip cfsDefaults cfs') + ) + + +instance Asset Lease where + calcCashflow l d _ = + do + (l',pmts) <- patchBalance l + let bal = getCurrentBal l' -- `debug` ("payments"++ show pmts) + let pDates = lastN (getRemainTerms l) $ getPaymentDates l 0 + let bals = tail $ scanl (-) bal pmts -- `debug` ("pDates "++ show pDates) + let defaults = replicate (length pDates) 0.0 -- `debug` ("bals"++ show bals++ ">> d"++ show d) + return $ CF.CashFlowFrame (head bals,max d (getOriginDate l), Nothing) $ cutBy Inc Future d (zipWith4 CF.LeaseFlow pDates bals pmts defaults) + + getOriginInfo (StepUpLease lInfo lsteupInfo bal rt st) = lInfo + getOriginInfo (RegularLease lInfo bal rt st) = lInfo + + getOriginDate (StepUpLease (LeaseInfo sd _ _ _) _ _ _ _) = sd + getOriginDate (RegularLease (LeaseInfo sd _ _ _) _ _ _) = sd + + getPaymentDates l ot + = case originRental (getOriginInfo l) of + ByDayRate _ dp -> genSerialDates dp Exc (getOriginDate l) (ot + getTotalTerms l) + ByPeriodRental _ per -> genDates (getOriginDate l) per (ot + getTotalTerms l) + + getRemainTerms (StepUpLease _ _ _ rt _) = rt + getRemainTerms (RegularLease _ _ rt _) = rt + + getTotalTerms (RegularLease (LeaseInfo _ ot _ _) _ _ _) = ot + getTotalTerms (StepUpLease (LeaseInfo _ ot _ _) _ _ _ _) = ot + + updateOriginDate (StepUpLease (LeaseInfo sd ot rental ob) lsu bal rt st) nd + = StepUpLease (LeaseInfo nd ot rental ob) lsu bal rt st + updateOriginDate (RegularLease (LeaseInfo sd ot rental ob) bal rt st) nd + = RegularLease (LeaseInfo nd ot rental ob) bal rt st + + -- resetToOrig (StepUpLease (LeaseInfo sd ot dp dr ob) lsu bal rt st) + -- = fst . patchBalance $ StepUpLease (LeaseInfo sd ot dp dr ob) lsu bal ot st + -- resetToOrig (RegularLease (LeaseInfo sd ot dp dr ob) bal rt st) + -- = fst . patchBalance $ RegularLease (LeaseInfo sd ot dp dr ob) bal ot st + + projCashflow l asOfDay (AP.LeaseAssump mDefault gapAssump rentAssump endType,_,_) mRates + = let + pdates = getPaymentDates l 0 -- `debug` ("8")-- `debug` ("RCURVE"++show rcCurve) + -- get the gap days between leases + pickGapDays (AP.GapDays days) = days + pickGapDays (AP.GapDaysByCurve cv) = getIntValOnByDate cv asOfDay + + newLeases = nextLeaseTill + l + (rentAssump , 0.0 , pickGapDays gapAssump) + (last pdates) + endType + [] + stressRentals = 0 + in + do + currentCf <- calcCashflow l asOfDay mRates + newCfs <- sequenceA [ calcCashflow l asOfDay mRates | l <- newLeases ] -- `debug` ("Current CF\n "++ show currentCf) + let (curCf,newTxns) = applyDefaults mDefault (currentCf, newCfs) + -- let allTxns = view CF.cashflowTxn currentCf ++ (concat $ (view CF.cashflowTxn) <$> newCfs) + let allTxns = curCf ++ concat newTxns + let begBal = CF.buildBegBal allTxns + return $ (CF.CashFlowFrame (begBal,max asOfDay (getOriginDate l),Nothing) allTxns, Map.empty) + + + projCashflow a b c d = Left $ "Failed to match when proj lease with assumption >>" ++ show a ++ show b ++ show c ++ show d + + getCurrentBal l = case l of + StepUpLease _ _ bal _ _ -> bal + RegularLease _ bal _ _-> bal + + -- getOriginRate (StepUpLease (LeaseInfo _ _ _ dr _) _ _ _ _) = fromRational $ toRational dr + -- getOriginRate (RegularLease (LeaseInfo _ _ _ dr _) _ _ _) = fromRational $ toRational dr + getOriginRate _ = 0.0 + + isDefaulted (StepUpLease _ _ _ rt Current) = False + isDefaulted (RegularLease _ _ rt Current) = False + isDefaulted _ = True + + getOriginBal l = + let + _sd = case l of + RegularLease (LeaseInfo sd _ _ _) bal _ _ -> sd + StepUpLease (LeaseInfo sd _ _ _) _ bal _ _ -> sd + in + case calcCashflow l _sd Nothing of + Right (CF.CashFlowFrame _ txns) -> CF.mflowBegBalance $ head txns + Left _ -> 0 + + splitWith (RegularLease (LeaseInfo sd ot dr ob) bal rt st ) rs + = [ RegularLease (LeaseInfo sd ot dr ob) (mulBR bal ratio) rt st | ratio <- rs ] + splitWith (StepUpLease (LeaseInfo sd ot dr ob) stup bal rt st ) rs + = [ StepUpLease (LeaseInfo sd ot dr ob) stup (mulBR bal ratio) rt st | ratio <- rs] + diff --git a/src/AssetClass/Loan.hs b/src/AssetClass/Loan.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/Loan.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module AssetClass.Loan + (projectLoanFlow,updateOriginDate) + where + +import qualified Data.Time as T +import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) +import qualified Assumptions as A +import InterestRate +import Asset +import Lib +import Util +import DateUtil +import Types +import qualified Data.Map as Map +import Data.List +import Data.Maybe +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import GHC.Generics + +import AssetClass.AssetBase +import AssetClass.AssetCashflow + +import Debug.Trace +import Assumptions (AssetDefaultAssumption(DefaultCDR)) +import qualified Asset as A +import Control.Lens hiding (element) +import Control.Lens.TH +debug = flip trace + + +-- instance Asset Loan where +projectLoanFlow :: ((Balance,Int,IRate), Balance, Date, AmortPlan, DayCount, IRate, Rational) -> (Dates, [DefaultRate],[PrepaymentRate],[IRate],[Int]) -> ([CF.TsRow],Rational) +projectLoanFlow ((originBal,ot,or), startBal, lastPayDate, pt, dc,startRate, begFactor) (cfDates,defRates,ppyRates,rateVector,remainTerms) = + let + initRow = CF.LoanFlow lastPayDate startBal 0.0 0.0 0.0 0.0 0.0 0.0 startRate Nothing + in + foldl + (\(acc,factor) (pDate, ppyRate, defRate, intRate, rt) + -> let + begBal = view CF.tsRowBalance (last acc) + lastPaidDate = getDate (last acc) + newDefault = mulBR begBal defRate + newPrepay = mulBR (begBal - newDefault) ppyRate + intBal = begBal - newDefault - newPrepay + newFactor = factor * (1-defRate) * (1- ppyRate ) + newInt = case (rt,pt) of + (0,F_P) -> 0 + (_,F_P) -> mulBR (mulBIR originBal or) newFactor + _ -> calcInt intBal lastPaidDate pDate intRate dc + newPrin = case (rt,pt) of + (1,I_P) -> intBal + (1,F_P) -> intBal + (0,F_P) -> 0 + (_,F_P) -> mulBR (divideBI intBal rt) newFactor + (_,I_P) -> 0 + (0,ScheduleRepayment cf _) -> intBal + (_,ScheduleRepayment cf _) -> + let + projAmt = fromRational $ getValByDate cf Inc pDate + in + if rt == 1 then + intBal + else + mulBR projAmt newFactor + _ -> error $ "failed to match Loan Project newPrin"++ show (rt,pt) + endBal = intBal - newPrin + in + (acc ++ [CF.LoanFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0 intRate Nothing] + ,newFactor)) + ([initRow],begFactor) + (zip5 cfDates ppyRates defRates rateVector remainTerms) + +instance Asset Loan where + calcCashflow pl@(PersonalLoan (LoanOriginalInfo ob or ot p sd ptype _) bal rate term _ ) asOfDay mRates + = fst <$> + projCashflow pl + asOfDay + (A.LoanAssump Nothing Nothing Nothing Nothing + ,A.DummyDelinqAssump + ,A.DummyDefaultAssump) + mRates + + getCurrentBal pl@(PersonalLoan (LoanOriginalInfo ob or ot p sd ptype _) _bal _rate _term _ ) + = _bal + + getOriginRate pl@(PersonalLoan (LoanOriginalInfo ob or ot p sd ptype _) _bal _rate _term _ ) + = case or of + Fix _ _r -> _r + Floater _ _ _ _r _ _ _ _ -> _r + + getCurrentRate pl@(PersonalLoan (LoanOriginalInfo ob or ot p sd ptype _) _bal _rate _term _ ) + = _rate + + getOriginBal pl@(PersonalLoan (LoanOriginalInfo ob _ _ _ _ _ _) _ _ _ _ ) = ob + + isDefaulted pl@(PersonalLoan _ _ _ _ (Defaulted _)) = True + isDefaulted PersonalLoan {} = False + + getOriginInfo (PersonalLoan oi cb cr rt st) = oi + getOriginDate (PersonalLoan (LoanOriginalInfo ob or ot p sd I_P _) cb cr rt st ) = sd + + resetToOrig m@(PersonalLoan (LoanOriginalInfo ob or ot p sd I_P obr) cb cr rt st ) + = PersonalLoan (LoanOriginalInfo ob or ot p sd I_P obr) ob (getOriginRate m) ot st + + getRemainTerms (PersonalLoan (LoanOriginalInfo ob or ot p sd I_P _) cb cr rt st ) = rt + + updateOriginDate (PersonalLoan (LoanOriginalInfo ob or ot p sd I_P obr) cb cr rt st ) nd + = PersonalLoan (LoanOriginalInfo ob or ot p nd I_P obr) cb cr rt st + + getPaymentDates pl@(PersonalLoan (LoanOriginalInfo ob _ ot p sd (ScheduleRepayment ts mDp) _) _bal _rate _term _ ) extra + = let + pdays = getTsDates ts + extraDates = genSerialDates (fromMaybe MonthEnd mDp) Inc (last pdays) extra + in + pdays ++ extraDates + + getPaymentDates pl@(PersonalLoan (LoanOriginalInfo ob _ ot p sd _ _) _bal _rate _term _ ) extra + = genDates sd p (ot+extra) + + -- ^ Project cashflow for loans with prepayment/default/loss and interest rate assumptions + projCashflow pl@(PersonalLoan (LoanOriginalInfo ob or ot p sd prinPayType _) cb cr rt Current) + asOfDay + (A.LoanAssump defaultAssump prepayAssump recoveryAssump ams,_,_) + mRate + = let + recoveryLag = maybe 0 getRecoveryLag recoveryAssump + lastPayDate:cfDates = lastN (rt + recoveryLag + 1) $ sd:getPaymentDates pl recoveryLag + in + do + rateVector <- A.projRates cr or mRate cfDates + ppyRates <- A.buildPrepayRates pl (lastPayDate:cfDates) prepayAssump + defRates <- A.buildDefaultRates pl (lastPayDate:cfDates) defaultAssump + let dc = getDayCount or + let remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt] -- `debug` ("rateVector"++show rateVector) + let initFactor = case prinPayType of + ScheduleRepayment ts _ -> + let + scheduleBals = scanl (-) ob $ fromRational <$> getTsVals ts + in + divideBB cb (scheduleBals!!(ot - rt)) + _ -> 1.0 + let (txns,_) = projectLoanFlow ((ob,ot,getOriginRate pl), cb,lastPayDate,prinPayType,dc,cr,initFactor) (cfDates,defRates,ppyRates,rateVector,remainTerms) -- `debug` (" rateVector"++show rateVector) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns recoveryAssump) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM) + -- ^ Project cashflow for defautled loans + projCashflow m@(PersonalLoan (LoanOriginalInfo ob or ot p sd prinPayType _) cb cr rt (Defaulted (Just defaultedDate))) + asOfDay + (_,_,A.DefaultedRecovery rr lag timing) + _ + = let + (cf_dates1,cf_dates2) = splitAt (pred lag) $ genDates defaultedDate p (lag+ length timing) + beforeRecoveryTxn = [ CF.LoanFlow d cb 0 0 0 0 0 0 cr Nothing| d <- cf_dates1 ] + recoveries = calcRecoveriesFromDefault cb rr timing + _txns = [ CF.LoanFlow d 0 0 0 0 0 r 0 cr Nothing | (d,r) <- zip cf_dates2 recoveries ] + (_, txns) = splitByDate (beforeRecoveryTxn++_txns) asOfDay EqToRight -- `debug` ("AS OF Date"++show asOfDay) + (futureTxns,historyM) = CF.cutoffTrs asOfDay txns + begBal = CF.buildBegBal futureTxns + in + Right $ (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns, historyM) + + projCashflow m@(PersonalLoan (LoanOriginalInfo ob or ot p sd prinPayType _) cb cr rt (Defaulted Nothing)) asOfDay assumps _ + = Right $ (CF.CashFlowFrame (cb,asOfDay,Nothing) [CF.LoanFlow asOfDay 0 0 0 0 0 0 0 cr Nothing],Map.empty) + + projCashflow a b c d = Left $ "failed to match projCashflow for Loan "++show a++show b++show c++show d + + splitWith l@(PersonalLoan (LoanOriginalInfo ob or ot p sd prinPayType obr) cb cr rt st) rs + = [ PersonalLoan (LoanOriginalInfo (mulBR ob ratio) or ot p sd prinPayType obr) (mulBR cb ratio) cr rt st | ratio <- rs ] diff --git a/src/AssetClass/MixedAsset.hs b/src/AssetClass/MixedAsset.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/MixedAsset.hs @@ -0,0 +1,252 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module AssetClass.MixedAsset + (projAssetUnion,projAssetUnionList,projectCashflow, calcAssetUnion,curBal) + where + +import qualified Data.Time as T +import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) +import qualified Assumptions as A +import qualified AssetClass.AssetBase as ACM +import InterestRate +import qualified Asset as P +import Lib +import Util +import DateUtil +import Types +import qualified Data.Map as Map +import Data.List +import Data.Maybe +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import GHC.Generics + +import AssetClass.AssetBase +import AssetClass.Mortgage +import AssetClass.Lease +import AssetClass.Loan +import AssetClass.Installment + +import AssetClass.Receivable +import AssetClass.AssetCashflow +import AssetClass.FixedAsset +import AssetClass.ProjectedCashFlow + +import Debug.Trace +import Assumptions (AssetDefaultAssumption(DefaultCDR)) +import qualified Asset as Ast + + + +instance P.Asset AssetUnion where + + calcCashflow ma asOfDay mRates = calcAssetUnion ma asOfDay mRates + + getCurrentBal ma = curBal ma + + getOriginBal ma = origBal ma + + getOriginRate ma = origRate ma + + getCurrentRate ma = currRate ma + + getOriginDate ma = origDate ma + + getOriginInfo ma = origInfo ma + + isDefaulted = isDefault + + getPaymentDates ma n = getPaydates ma n + + getRemainTerms = remainTerms + + projCashflow ma asOfDay assumps mRates = projAssetUnion ma asOfDay assumps mRates + + getBorrowerNum = borrowerNum + + splitWith = splitWith + + updateOriginDate = updateOrigDate + + calcAlignDate = calcAlignDate + +curBal:: ACM.AssetUnion -> Balance +curBal (ACM.MO ast) = P.getCurrentBal ast +curBal (ACM.LO ast) = P.getCurrentBal ast +curBal (ACM.IL ast) = P.getCurrentBal ast +curBal (ACM.LS ast) = P.getCurrentBal ast +curBal (ACM.FA ast) = P.getCurrentBal ast +curBal (ACM.RE ast) = P.getCurrentBal ast +curBal (ACM.PF ast) = P.getCurrentBal ast + +origBal :: ACM.AssetUnion -> Balance +origBal (ACM.MO ast) = P.getOriginBal ast +origBal (ACM.LO ast) = P.getOriginBal ast +origBal (ACM.IL ast) = P.getOriginBal ast +origBal (ACM.LS ast) = P.getOriginBal ast +origBal (ACM.FA ast) = P.getOriginBal ast +origBal (ACM.RE ast) = P.getOriginBal ast +origBal (ACM.PF ast) = P.getOriginBal ast + +origRate :: ACM.AssetUnion -> IRate +origRate (ACM.MO ast) = P.getOriginRate ast +origRate (ACM.LO ast) = P.getOriginRate ast +origRate (ACM.IL ast) = P.getOriginRate ast +origRate (ACM.LS ast) = P.getOriginRate ast +origRate (ACM.FA ast) = P.getOriginRate ast +origRate (ACM.RE ast) = P.getOriginRate ast +origRate (ACM.PF ast) = P.getOriginRate ast + +currRate :: ACM.AssetUnion -> IRate +currRate (ACM.MO ast) = P.getCurrentRate ast +currRate (ACM.LO ast) = P.getCurrentRate ast +currRate (ACM.IL ast) = P.getCurrentRate ast +currRate (ACM.LS ast) = P.getCurrentRate ast +currRate (ACM.FA ast) = P.getCurrentRate ast +currRate (ACM.RE ast) = P.getCurrentRate ast +currRate (ACM.PF ast) = P.getCurrentRate ast + + +origDate :: ACM.AssetUnion -> Date +origDate (ACM.MO ast) = P.getOriginDate ast +origDate (ACM.LO ast) = P.getOriginDate ast +origDate (ACM.IL ast) = P.getOriginDate ast +origDate (ACM.LS ast) = P.getOriginDate ast +origDate (ACM.FA ast) = P.getOriginDate ast +origDate (ACM.RE ast) = P.getOriginDate ast +origDate (ACM.PF ast) = P.getOriginDate ast + + +origInfo :: ACM.AssetUnion -> OriginalInfo +origInfo (ACM.MO ast) = P.getOriginInfo ast +origInfo (ACM.LO ast) = P.getOriginInfo ast +origInfo (ACM.IL ast) = P.getOriginInfo ast +origInfo (ACM.LS ast) = P.getOriginInfo ast +origInfo (ACM.FA ast) = P.getOriginInfo ast +origInfo (ACM.RE ast) = P.getOriginInfo ast +origInfo (ACM.PF ast) = P.getOriginInfo ast + +isDefault :: ACM.AssetUnion -> Bool +isDefault (ACM.MO ast) = P.isDefaulted ast +isDefault (ACM.LO ast) = P.isDefaulted ast +isDefault (ACM.IL ast) = P.isDefaulted ast +isDefault (ACM.LS ast) = P.isDefaulted ast +isDefault (ACM.FA ast) = P.isDefaulted ast +isDefault (ACM.RE ast) = P.isDefaulted ast +isDefault (ACM.PF ast) = P.isDefaulted ast + +getPaydates :: ACM.AssetUnion -> Int -> [Date] +getPaydates (ACM.MO ast) n = P.getPaymentDates ast n +getPaydates (ACM.LO ast) n = P.getPaymentDates ast n +getPaydates (ACM.IL ast) n = P.getPaymentDates ast n +getPaydates (ACM.LS ast) n = P.getPaymentDates ast n +getPaydates (ACM.FA ast) n = P.getPaymentDates ast n +getPaydates (ACM.RE ast) n = P.getPaymentDates ast n +getPaydates (ACM.PF ast) n = P.getPaymentDates ast n + +remainTerms :: ACM.AssetUnion -> Int +remainTerms (ACM.MO ast) = P.getRemainTerms ast +remainTerms (ACM.LO ast) = P.getRemainTerms ast +remainTerms (ACM.IL ast) = P.getRemainTerms ast +remainTerms (ACM.LS ast) = P.getRemainTerms ast +remainTerms (ACM.FA ast) = P.getRemainTerms ast +remainTerms (ACM.RE ast) = P.getRemainTerms ast +remainTerms (ACM.PF ast) = P.getRemainTerms ast + +borrowerNum :: ACM.AssetUnion -> Int +borrowerNum (ACM.MO ast) = P.getBorrowerNum ast +borrowerNum (ACM.LO ast) = P.getBorrowerNum ast +borrowerNum (ACM.IL ast) = P.getBorrowerNum ast +borrowerNum (ACM.LS ast) = P.getBorrowerNum ast +borrowerNum (ACM.FA ast) = P.getBorrowerNum ast +borrowerNum (ACM.RE ast) = P.getBorrowerNum ast +borrowerNum (ACM.PF ast) = P.getBorrowerNum ast + +splitWith :: ACM.AssetUnion -> [Rate] -> [ACM.AssetUnion] +splitWith (ACM.MO ast) rs = ACM.MO <$> P.splitWith ast rs +splitWith (ACM.LO ast) rs = ACM.LO <$> P.splitWith ast rs +splitWith (ACM.IL ast) rs = ACM.IL <$> P.splitWith ast rs +splitWith (ACM.LS ast) rs = ACM.LS <$> P.splitWith ast rs +splitWith (ACM.FA ast) rs = ACM.FA <$> P.splitWith ast rs +splitWith (ACM.RE ast) rs = ACM.RE <$> P.splitWith ast rs +splitWith (ACM.PF ast) rs = ACM.PF <$> P.splitWith ast rs +-- splitWith (ACM.RE ast) rs = ACM.RE <$> P.splitWith ast rs + +updateOrigDate :: ACM.AssetUnion -> Date -> ACM.AssetUnion +updateOrigDate (ACM.MO ast) d = ACM.MO $ P.updateOriginDate ast d +updateOrigDate (ACM.LO ast) d = ACM.LO $ P.updateOriginDate ast d +updateOrigDate (ACM.IL ast) d = ACM.IL $ P.updateOriginDate ast d +updateOrigDate (ACM.LS ast) d = ACM.LS $ P.updateOriginDate ast d +updateOrigDate (ACM.FA ast) d = ACM.FA $ P.updateOriginDate ast d +updateOrigDate (ACM.RE ast) d = ACM.RE $ P.updateOriginDate ast d +updateOrigDate (ACM.PF ast) d = ACM.PF $ P.updateOriginDate ast d +-- updateOrigDate (ACM.RE ast) d = ACM.RE $ P.updateOriginDate ast d + +calcAlignDate :: ACM.AssetUnion -> Date -> Date +calcAlignDate (ACM.MO ast) = P.calcAlignDate ast +calcAlignDate (ACM.LO ast) = P.calcAlignDate ast +calcAlignDate (ACM.IL ast) = P.calcAlignDate ast +calcAlignDate (ACM.LS ast) = P.calcAlignDate ast +calcAlignDate (ACM.FA ast) = P.calcAlignDate ast +calcAlignDate (ACM.RE ast) = P.calcAlignDate ast +calcAlignDate (ACM.PF ast) = P.calcAlignDate ast +-- calcAlignDate (ACM.RE ast) = P.calcAlignDate ast + +calcAssetUnion :: ACM.AssetUnion -> Date -> Maybe [RateAssumption] -> Either String CF.CashFlowFrame +calcAssetUnion (ACM.MO ast) d mRates = P.calcCashflow ast d mRates +calcAssetUnion (ACM.LO ast) d mRates = P.calcCashflow ast d mRates +calcAssetUnion (ACM.IL ast) d mRates = P.calcCashflow ast d mRates +calcAssetUnion (ACM.LS ast) d mRates = P.calcCashflow ast d mRates +calcAssetUnion (ACM.FA ast) d mRates = P.calcCashflow ast d mRates +calcAssetUnion (ACM.RE ast) d mRates = P.calcCashflow ast d mRates +calcAssetUnion (ACM.PF ast) d mRates = P.calcCashflow ast d mRates +calcAssetUnion x _ _ = Left ("Failed to match proj AssetUnion"++ show x) + +projAssetUnion :: ACM.AssetUnion -> Date -> A.AssetPerf -> Maybe [RateAssumption] + -> Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance) +projAssetUnion (ACM.MO ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnion (ACM.LO ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnion (ACM.IL ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnion (ACM.LS ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnion (ACM.FA ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnion (ACM.RE ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnion (ACM.PF ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnion x _ _ _ = Left ("Failed to match proj AssetUnion"++ show x) + +projAssetUnionList :: [ACM.AssetUnion] -> Date -> A.ApplyAssumptionType -> Maybe [RateAssumption] + -> Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance) +projAssetUnionList [] d (A.PoolLevel assetPerf) mRate = Right $ (CF.CashFlowFrame (0,d,Nothing) [], Map.empty) +projAssetUnionList assets d (A.PoolLevel assetPerf) mRate = + let + prjList = [ projAssetUnion asset d assetPerf mRate | asset <- assets ] + results::(Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)]) = sequenceA prjList + in + do + r <- results + let cfs = fst <$> r + let bals = snd <$> r + return (foldl1 CF.mergePoolCf2 cfs, Map.unionsWith (+) bals) + +projAssetUnionList assets d _ mRate = Left " not implemented on asset level assumption for revolving pool" + + +projectCashflow :: MixedAsset -> Date -> Map.Map String A.ApplyAssumptionType -> Maybe [RateAssumption] + -> Either String (Map.Map String (CF.CashFlowFrame, Map.Map CutoffFields Balance)) +projectCashflow (MixedPool assetMap) asOfDate mAssump mRate + = let + mWithCf = Map.mapWithKey + (\k astList -> projAssetUnionList + astList + asOfDate + (case Map.lookup k mAssump of + Just assump -> assump + Nothing -> error ("Failed to read sub assump:"++k)) + mRate) + assetMap + in + sequenceA mWithCf diff --git a/src/AssetClass/Mortgage.hs b/src/AssetClass/Mortgage.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/Mortgage.hs @@ -0,0 +1,640 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module AssetClass.Mortgage + (projectMortgageFlow,projectScheduleFlow,updateOriginDate,getOriginInfo + ,buildARMrates) + where + +import qualified Data.Time as T +import qualified Cashflow as CF +import qualified Assumptions as A +import Asset as Ast +import Types +import Lib +import Util +import DateUtil +import InterestRate as IR + +import qualified Data.Map as Map +import Data.List +import Data.Ratio +import Data.Maybe +import GHC.Generics +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types + +import AssetClass.AssetBase +import AssetClass.AssetCashflow +import Debug.Trace +import Assumptions (AssetPerfAssumption(MortgageAssump)) +import GHC.Float.RealFracMethods (truncateFloatInteger) +import Cashflow (extendTxns) +import Control.Lens hiding (element) +import Control.Lens.TH +import qualified Data.DList as DL + +debug = flip trace + +projectMortgageFlow :: (Balance, Balance, Date, Maybe BorrowerNum, AmortPlan, DayCount, IRate, Period, Int) -> (Dates, [DefaultRate],[PrepaymentRate],[IRate],[Int]) -> (DL.DList CF.TsRow, Balance, Balance) +projectMortgageFlow (originBal, startBal, lastPayDate, mbn, pt, dc, startRate, p, oTerms) (cfDates, defRates, ppyRates, rateVector, remainTerms) = + let + initRow = CF.MortgageFlow lastPayDate startBal 0.0 0.0 0.0 0.0 0.0 0.0 startRate Nothing Nothing Nothing + in + foldl + (\(acc, begBal, lastOriginBal) (pDate, defRate, ppyRate, intRate, rt) + -> let + -- begBal = view CF.tsRowBalance (last acc) + -- lastPaidDate = getDate (last acc) -- `debug` ("beg bal"++ show begBal) + newDefault = mulBR begBal defRate -- `debug` ("new default"++ show defRate++ ">>"++ show begBal) + newPrepay = mulBR (begBal - newDefault) ppyRate + -- performing balance + _balAfterPpy = begBal - newDefault - newPrepay -- `debug` ("new ppy "++ show newPrepay ++ "beg bal"++ show (begBal - newDefault) ++ "ppy rate"++ show ppyRate) + -- performing original balance + amortBal = mulBR lastOriginBal $ (1-defRate) * (1-ppyRate) + amortTerm = case pt of + Balloon aTerm -> aTerm + _ -> oTerms + + (newInt,newPrin) = calcAssetPrinInt pt _balAfterPpy (periodRateFromAnnualRate p intRate) oTerms rt (amortBal, amortTerm) -- `debug` ("using bal for pmt"++ show _balAfterPpy) + endBal = _balAfterPpy - newPrin + newMbn = decreaseBorrowerNum begBal endBal mbn -- `debug` ("rt in mortgage proj"++ show rt) + in + (DL.snoc acc (CF.MortgageFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0 intRate newMbn Nothing Nothing), endBal ,amortBal) + ) + (DL.singleton initRow, startBal, originBal) + (zip5 cfDates defRates ppyRates rateVector remainTerms) + + +projectDelinqMortgageFlow :: ([CF.TsRow],[CF.TsRow]) -> Balance -> Maybe Int -> Date -> [Date] -> [Rate] -> [PrepaymentRate] -> [IRate] -> (Rate,Lag,Rate,Lag,Period,AmortPlan,Int) -> ([Balance],[Balance],[Balance]) -> [CF.TsRow] +projectDelinqMortgageFlow (trs,[]) _ _ _ [] _ _ _ _ _ = CF.dropTailEmptyTxns trs +projectDelinqMortgageFlow (trs,backToPerfs) _ _ _ [] _ _ _ _ _ = + let + consolTxn = sort backToPerfs -- `debug` ("Hit pay dates = []") + (trsKeep,trsMerge) = splitByDate trs (getDate (head backToPerfs)) EqToRight + mergedTrs = CF.combineTss [] trsMerge consolTxn -- `debug` ("before Merge for delinq Mortgage \n >>> "++ show trs++"Back to Perf"++ show backToPerfs) + in + trsKeep ++ mergedTrs -- `debug` ("\n MergedTrs \n"++ show mergedTrs) + +projectDelinqMortgageFlow (trs,backToPerfs) beginBal mbn lastDate (pDate:pDates) (delinqRate:delinqRates) (ppyRate:ppyRates) (rate:rates) + (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinType,ot) + (dBal:defaultVec,rAmt:recoveryVec,lAmt:lossVec) + = projectDelinqMortgageFlow (trs++[tr],CF.combineTss [] backToPerfs newPerfCfs) endingBal newMbn pDate pDates delinqRates ppyRates rates + (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinType,ot) + (newDefaultVec,newRecoveryVec,newLossVec) -- `debug` ("\n calc Date"++ show pDate ++"\n from new perf"++ show backToPerfBal ++"\n new cfs >>> \n"++ show newPerfCfs) + where + remainTerms = succ $ max 0 (length pDates - recoveryLag - defaultLag) + delinqBal = mulBR beginBal delinqRate + + defaultBal = mulBR delinqBal defaultPct + recBal = mulBR defaultBal recoveryRate + lossBal = mulBR defaultBal (1 - recoveryRate) + + newDefaultVec = replace defaultVec (pred defaultLag) defaultBal + newRecoveryVec = replace recoveryVec (pred recoveryLag + defaultLag) recBal + newLossVec = replace lossVec (pred recoveryLag + defaultLag) lossBal + + backToPerfBal = mulBR delinqBal (1 - defaultPct) + + restPerfVector = replicate (succ (length delinqRates)) 0 + restPerfBal = fromRational <$> restPerfVector -- `debug` ("Dates"++show (pDate:pDates)) + newPerfCfs = if backToPerfBal > 0.0 then + projectDelinqMortgageFlow ([],[]) backToPerfBal Nothing (pDates!!defaultLag) (drop defaultLag (pDate:pDates)) + restPerfVector restPerfVector + (drop defaultLag (rate:rates)) + (0,0,0,0,p,prinType,ot) + (restPerfBal,restPerfBal,restPerfBal) -- `debug` ("\nStarting new perf >>> \n"++ show backToPerfBal) + else + [] + + balAfterDelinq = beginBal - delinqBal + ppyAmt = mulBR balAfterDelinq ppyRate + balAfterPpy = balAfterDelinq - ppyAmt + periodRate = periodRateFromAnnualRate p rate + amortTerm = case prinType of + Balloon aTerm -> aTerm + _ -> ot + -- scheduleBalance = calcScheduleBalaceToday m + (intAmt, prinAmt) = calcAssetPrinInt prinType balAfterPpy periodRate ot remainTerms (0,amortTerm) + + endingBal = beginBal - prinAmt - ppyAmt - delinqBal -- `debug` ("DATE"++show pDate++">>>"++ show beginBal++">>"++show prinAmt ++ ">>" ++ show ppyAmt ++ ">>"++ show delinqBal) + downFactor = divideBB beginBal endingBal + newMbn = decreaseBorrowerNum beginBal endingBal mbn + tr = CF.MortgageDelinqFlow pDate endingBal prinAmt intAmt ppyAmt delinqBal dBal rAmt lAmt rate newMbn Nothing Nothing-- `debug` ("Date"++ show pDate ++ "ENDING BAL AT"++ show endingBal) + + +projectScheduleFlow :: [CF.TsRow] -> Rate -> Balance -> [CF.TsRow] -> [DefaultRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> (Int, Rate) -> [CF.TsRow] +projectScheduleFlow trs _ last_bal [] _ _ [] [] (_,_) = trs +projectScheduleFlow trs bal_factor last_bal (flow:flows) (defRate:defRates) (ppyRate:ppyRates) recV lossV (recoveryLag,recoveryRate) + = projectScheduleFlow (trs++[tr]) surviveRate endBal flows defRates ppyRates (tail recVector) (tail lossVector) (recoveryLag,recoveryRate) -- `debug` ("===>C") + where + startBal = last_bal + defAmt = mulBR startBal defRate + ppyAmt = mulBR (startBal - defAmt) ppyRate + afterBal = startBal - defAmt - ppyAmt + + surviveRate = (1 - defRate) * (1 - ppyRate) * bal_factor + schedulePrin = mulBR (CF.mflowPrincipal flow) surviveRate --TODO round trip -- `debug` ("Schedule Principal"++(printf "%.2f" (CF.mflowPrincipal flow))++" Rate"++show(_schedule_rate)) + scheduleInt = mulBR (CF.mflowInterest flow) surviveRate + + newRec = mulBR defAmt recoveryRate + newLoss = mulBR defAmt (1 - recoveryRate) + + recVector = replace recV recoveryLag newRec + lossVector = replace lossV recoveryLag newLoss + + endBal = max 0 $ afterBal - schedulePrin + + tr = CF.MortgageFlow (CF.getDate flow) endBal schedulePrin scheduleInt ppyAmt defAmt (head recVector) (head lossVector) 0.0 Nothing Nothing Nothing--TODO missing ppy-penalty here + +projectScheduleFlow trs b_factor lastBal [] _ _ (r:rs) (l:ls) (recovery_lag,recovery_rate) + = projectScheduleFlow (trs++[tr]) b_factor lastBal [] [] [] rs ls (recovery_lag - 1,recovery_rate) + where + remain_length = length rs + lastDate = CF.getDate (last trs) + flowDate = nextDate lastDate Lib.Monthly + tr = CF.MortgageFlow flowDate lastBal 0 0 0 0 r l 0.0 Nothing Nothing Nothing + +type DelinqRate = Rate +projectScheduleDelinqFlow :: ([CF.TsRow],[CF.TsRow]) -> Rate -> Balance -> [CF.TsRow] -> [DelinqRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> [Amount] -> (Rate,Int,Rate,Int) -> [CF.TsRow] +projectScheduleDelinqFlow (trs,[]) _ begBal flows [] [] defaults recoveries losses _ = + let + patchedFlows = [ CF.MortgageDelinqFlow d begBal prin int prepay delinq defVal recVal lossVal rate mB mPPN Nothing + | (CF.MortgageDelinqFlow d bal prin int prepay delinq _ _ _ rate mB mPPN Nothing,defVal,recVal,lossVal) <- zip4 flows defaults recoveries losses] -- `debug` ("Length of default"++ show defaults++">>recovery>>"++ show recoveries++">>loss>>"++ show losses) + r1 = sort $ trs ++ patchedFlows -- `debug` ("Patched rows\n"++show patchedFlows) + in + r1 + +projectScheduleDelinqFlow (trs,newPerfs) _ begBal flows [] [] defaults recoveries losses _ = + let + patchedFlows = [ CF.MortgageDelinqFlow d begBal prin int prepay delinq defVal recVal lossVal rate mB mPPN Nothing + | (CF.MortgageDelinqFlow d bal prin int prepay delinq _ _ _ rate mB mPPN Nothing,defVal,recVal,lossVal) <- zip4 flows defaults recoveries losses] -- `debug` ("Length of default"++ show defaults++">>recovery>>"++ show recoveries++">>loss>>"++ show losses) + r1 = sort $ trs ++ patchedFlows -- `debug` ("Patched rows\n"++show patchedFlows) + r3 = CF.aggregateTsByDate [] $ sort newPerfs -- `debug` ("New Perfs\n"++ show newPerfs) + (r1keep, r1merge) = splitByDate r1 (getDate (head r3)) EqToRight -- `debug` ("r3 \n"++ show r3) + r4 = CF.combineTss [] r1merge r3 -- `debug` ("r1keep \n"++ show r1keep++"\n r1merge \n"++ show r1merge) + in + r1keep ++ r4 -- `debug` ("r4 \n"++ show r4) + +projectScheduleDelinqFlow (trs,backToPerfCfs) surviveRate begBal (flow:flows) (delinqRate:delinqRates) (ppyRate:ppyRates) (defaultBal:defaultBals) (recoveryBal:recoveryBals) (lossBal:lossBals) (defaultPct,defaultLag,recoveryRate,recoveryLag) + = projectScheduleDelinqFlow (trs++[tr],CF.combineTss [] backToPerfCfs currentBackToPerfCfs) newSurviveRate endBal flows delinqRates ppyRates newDefaultBals newRecoveryBals newLossBals (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("new back to perf flow"++ show backToPerfCfs) + where + delinqAmt = mulBR begBal delinqRate -- `debug` ("delinq Rate"++ show delinqRate) + ppyAmt = mulBR (begBal - delinqAmt) ppyRate -- `debug` ("begbal"++ show begBal++">>"++ show delinqAmt) + newSurviveRate = (1-delinqRate) * (1-ppyRate) * surviveRate + + scheduleBal = view CF.tsRowBalance flow + schedulePrin = mulBR (CF.mflowPrincipal flow) surviveRate + scheduleInt = mulBR (CF.mflowInterest flow) surviveRate + + newDefaultBal = mulBR delinqAmt defaultPct + endBal = max 0 $ (begBal - delinqAmt - ppyAmt - schedulePrin) + currentBackToPerfCfs = let + futureDs = drop (defaultLag+recoveryLag) $ getDates (flow:flows) + splitPct = divideBB (mulBR delinqAmt (1-defaultPct)) begBal + perfFlows = take (length flows - defaultLag - recoveryLag + 1) $ CF.splitTrs splitPct (flow:flows) + in + [ set CF.tsDate d f | (d,f) <- zip futureDs perfFlows ] + + newDefaultBals = replace defaultBals (pred defaultLag) newDefaultBal + newRecoveryBals = replace recoveryBals (recoveryLag + pred defaultLag) (mulBR newDefaultBal recoveryRate) + newLossBals = replace lossBals (recoveryLag + pred defaultLag) (mulBR newDefaultBal (1-recoveryRate)) -- `debug` ("new loss def"++ show defaultBal++">>rate"++ show (1-recoveryRate) ) + tr = CF.MortgageDelinqFlow (CF.getDate flow) endBal schedulePrin scheduleInt ppyAmt delinqAmt defaultBal recoveryBal lossBal (CF.mflowRate flow) Nothing + Nothing Nothing -- `debug` ("|||>>> proj at date"++ show (CF.getDate flow)) + +-- | implementation on projection via default balance amount +projCashflowByDefaultAmt :: (Balance, Date, AmortPlan, Period,IRate,Maybe BorrowerNum) -> (Dates, ([Balance],[Balance]), [Rate], [IRate], [Int]) -> [CF.TsRow] +projCashflowByDefaultAmt (cb,lastPayDate,pt,p,cr,mbn) (cfDates,(expectedDefaultBals,unAppliedDefaultBals), ppyRates, rateVector, remainTerms) = + let + initRow = CF.MortgageFlow lastPayDate cb 0.0 0.0 0.0 0.0 0.0 0.0 cr mbn Nothing Nothing + in + foldl + (\acc (pDate, (defaultBal,futureDefualtBal), ppyRate, rate, rt) + -> let + begBal = view CF.tsRowBalance (last acc) + mBorrower = CF.mflowBorrowerNum (last acc) + newDefault = if begBal <= (defaultBal+futureDefualtBal) then + begBal + else + defaultBal + newPrepay = mulBR (max 0 (begBal - newDefault)) ppyRate -- `debug` ("mb from last"++ show mBorrower) + newInt = mulBI (max 0 (begBal - newDefault - newPrepay)) (periodRateFromAnnualRate p rate) + intBal = max 0 $ begBal - newDefault - newPrepay -- `debug` ("using rt"++ show rt) + newPrin = case (rt,pt) of + (0,_) -> intBal + (_,Level) -> let + pmt = calcPmt intBal (periodRateFromAnnualRate p rate) rt -- `debug` ("PMT with rt"++ show rt) + in + pmt - newInt + (_,Even) -> intBal / fromIntegral rt + _ -> error ("Unsupport Prin type for mortgage"++ show pt) + endBal = intBal - newPrin + newMbn = decreaseBorrowerNum begBal endBal mBorrower -- `debug` (">>> pdate"++ show pDate) + in + acc ++ [CF.MortgageFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0 rate newMbn Nothing Nothing] + ) + [initRow] + (zip5 cfDates (zip expectedDefaultBals unAppliedDefaultBals) ppyRates rateVector remainTerms) + +-- TODO to fix here , hard code on Left +calcScheduleBalaceToday :: Mortgage -> Maybe [RateAssumption] -> Date -> Balance +calcScheduleBalaceToday m mRates asOfDay + = let + sd = Ast.getOriginDate m + in + case calcCashflow (resetToOrig m) sd mRates of + Right (CF.CashFlowFrame _ scheduleTxn) -> + case getByDate asOfDay scheduleTxn of + Just f -> view CF.tsRowBalance f + Nothing -> error "Failed to find schedule balance" + Left _ -> 0 + + +-- | implementation on projection via default balance amount +projScheduleCashflowByDefaultAmt :: (Balance, Date,IRate,Maybe BorrowerNum) -> ([CF.TsRow], ([Balance],[Balance]), [Rate] ) -> ([CF.TsRow], Rate) +projScheduleCashflowByDefaultAmt (cb,lastPayDate,cr,mbn) (scheduleFlows,(expectedDefaultBals,unAppliedDefaultBals), ppyRates) = + let + initRow = CF.MortgageFlow lastPayDate cb 0.0 0.0 0.0 0.0 0.0 0.0 cr mbn Nothing Nothing + in + foldl + (\(acc,factor) (cflow, (defaultBal,futureDefualtBal), ppyRate) + -> let + pDate = getDate cflow + + begBal = view CF.tsRowBalance (last acc) + mBorrower = CF.mflowBorrowerNum (last acc) + + newDefault = if begBal <= (defaultBal+futureDefualtBal) then + begBal + else + defaultBal + newPrepay = mulBR (max 0 (begBal - newDefault)) ppyRate -- `debug` ("mb from last"++ show mBorrower) + + intBal = max 0 $ begBal - newDefault - newPrepay + defRate = if (begBal - newPrepay) /= 0 then + divideBB newDefault (begBal - newPrepay) + else + 0 + newFactor = (1 - ppyRate) * (1 - defRate) * factor + newInt = mulBR (CF.mflowInterest cflow) newFactor + newPrin = mulBR (CF.mflowPrincipal cflow) newFactor + + endBal = intBal - newPrin + newMbn = decreaseBorrowerNum begBal endBal mBorrower + in + (acc ++ [CF.MortgageFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0 + cr newMbn Nothing Nothing] + ,newFactor) + ) + ([initRow],1.0) + (zip3 scheduleFlows (zip expectedDefaultBals unAppliedDefaultBals) ppyRates) + +buildARMrates :: IR.RateType -> (ARM,Date,Date,Date,IRate) -> Maybe [RateAssumption] -> Ts +buildARMrates (IR.Fix _ _ ) _ _ = error "ARM should have floater rate" +buildARMrates or@(IR.Floater _ idx sprd initRate dp _ _ mRoundBy ) + (arm, startDate, firstResetDate, lastCfDate, beginRate) mRates + = let + resetDates = genSerialDatesTill2 IE firstResetDate dp lastCfDate + projectFutureActualCurve = runInterestRate2 arm (startDate,beginRate) or resetDates + in + case A.getRateAssumption (fromMaybe [] mRates) idx of + Just (RateCurve idx curve) + -> projectFutureActualCurve curve + Just (RateFlat idx v) + -> projectFutureActualCurve (mkRateTs [(startDate, v),(lastCfDate,v)]) -- `debug` ("lpd"++show last_pay_date++"lpd"++ show (last cf_dates)) + Nothing -> error $ "Failed to find index"++ show idx + +instance Ast.Asset Mortgage where + calcCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd ptype _ _) _bal _rate _term _mbn _) d mRates + = fst <$> (projCashflow m d (MortgageAssump Nothing Nothing Nothing Nothing + ,A.DummyDelinqAssump + ,A.DummyDefaultAssump) mRates) + + calcCashflow s@(ScheduleMortgageFlow beg_date flows _) d _ + = Right $ CF.CashFlowFrame ( ((view CF.tsRowBalance) . head) flows, beg_date, Nothing ) flows + + calcCashflow m@(AdjustRateMortgage _origin _arm _bal _rate _term _mbn _status) d mRates = Left $ "to be implement on adjust rate mortgage" + + getCurrentBal (Mortgage _ _bal _ _ _ _) = _bal + getCurrentBal (AdjustRateMortgage _ _ _bal _ _ _ _) = _bal + + getOriginBal (Mortgage (MortgageOriginalInfo _bal _ _ _ _ _ _ _) _ _ _ _ _ ) = _bal + getOriginBal (AdjustRateMortgage (MortgageOriginalInfo _bal _ _ _ _ _ _ _) _ _ _ _ _ _ ) = _bal + + getOriginRate m + = let + (MortgageOriginalInfo _ or _ _ _ _ _ _) = getOriginInfo m + in + case or of + IR.Fix _ _r -> _r + IR.Floater _ _ _ _r _ _ _ _ -> _r + + getCurrentRate (Mortgage _ _ r _ _ _) = r + getCurrentRate (AdjustRateMortgage _ _ _ r _ _ _) = r + getCurrentRate (ScheduleMortgageFlow _ flows _) = 0.0 + + resetToOrig m@(Mortgage (MortgageOriginalInfo ob or ot p sd pt pp obr) cb cr rt mBn st) + = Mortgage (MortgageOriginalInfo ob or ot p sd pt pp obr) + ob + (getOriginRate m) + ot + mBn + st --TODO borrowerNum is not being updated + resetToOrig m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd pt pp obr) arm cb cr rt mBn st) + = AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd pt pp obr) + arm + ob + (getOriginRate m) + ot + mBn + st --TODO borrowerNum is not being updated + resetToOrig m@(ScheduleMortgageFlow begDate flows dp) = m + + getPaymentDates (Mortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ _ _) extra = genDates sd p (ot+extra) + getPaymentDates (AdjustRateMortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ _ _ _) extra = genDates sd p (ot+extra) + getPaymentDates (ScheduleMortgageFlow begDate flows dp) extra + = let + lastPayDay = (getDate . last) flows + extDates = genSerialDates dp Exc lastPayDay extra + in + getDates flows ++ extDates + + isDefaulted (Mortgage _ _ _ _ _ (Defaulted _)) = True + isDefaulted (AdjustRateMortgage _ _ _ _ _ _ (Defaulted _)) = True + isDefaulted Mortgage {} = False + isDefaulted AdjustRateMortgage {} = False + + getOriginDate (Mortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ ct _ _) = sd + getOriginDate (AdjustRateMortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ ct _ _) = sd + getOriginDate (ScheduleMortgageFlow begDate _ _) = begDate + + getRemainTerms (Mortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ ct _ _) = ct + getRemainTerms (AdjustRateMortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ ct _ _) = ct + + getOriginInfo (Mortgage oi _ _ _ _ _) = oi + getOriginInfo (AdjustRateMortgage oi _ _ _ _ _ _) = oi + + updateOriginDate (Mortgage (MortgageOriginalInfo ob or ot p sd _type mpn obr) cb cr ct mbn st) nd + = Mortgage (MortgageOriginalInfo ob or ot p nd _type mpn obr) cb cr ct mbn st + updateOriginDate (AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd _type mpn obr) arm cb cr ct mbn st) nd + = AdjustRateMortgage (MortgageOriginalInfo ob or ot p nd _type mpn obr) arm cb cr ct mbn st + + -- project current mortgage with total default amt + projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current) + asOfDay + mars@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams ,_ ,_) + mRates = + let + recoveryLag = maybe 0 getRecoveryLag amr + lastPayDate:cfDates = lastN (succ (recoveryLag + rt)) $ sd:getPaymentDates m recoveryLag + expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) (length cfDates) + unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals + remainTerms = paddingDefault 0 (reverse [0..(length cfDates - recoveryLag)]) (length cfDates) + in + do + rateVector <- A.projRates cr or mRates cfDates + ppyRates <- Ast.buildPrepayRates m (lastPayDate:cfDates) amp + let txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn) + (cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) + + -- project current adjMortgage with total default amt + projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current) + asOfDay + mars@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams,_,_) + mRates = + let + ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm + passInitPeriod = (ot - rt) >= initPeriod + firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) + + lastPayDate:cfDates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recoveryLag + 1) $ sd:getPaymentDates m recoveryLag + rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates + rateVector = fromRational <$> getValByDates rateCurve Inc cfDates + expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) (length cfDates) + unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals + recoveryLag = maybe 0 getRecoveryLag amr + remainTerms = paddingDefault 0 (reverse [0..(length cfDates - recoveryLag)]) (length cfDates) + in + do + ppyRates <- Ast.buildPrepayRates m (lastPayDate:cfDates) amp + let txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn) (cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) + -- project schedule cashflow with total default amount + projCashflow m@(ScheduleMortgageFlow begDate flows dp) asOfDay + assumps@(pAssump@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams ),dAssump,fAssump) _ + = let + begBal = CF.mflowBegBalance $ head flows + begDate = getDate $ head flows + begRate = CF.mflowRate $ head flows + begMbn = CF.mflowBorrowerNum $ head flows + originCfDates = CF.getDate <$> flows + originFlowSize = length flows + recoveryLag = maybe 0 getRecoveryLag amr + totalLength = recoveryLag + originFlowSize + expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) totalLength + unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals + endDate = (CF.getDate . last) flows + extraDates = genSerialDates dp Exc endDate recoveryLag + flowsWithEx = flows ++ extendTxns (last flows) extraDates -- `debug` (">> end date"++ show endDate++">>> extra dates"++show extraDates) + in + do + _ppyRate <- Ast.buildPrepayRates m (begDate:originCfDates) amp + let ppyRates = paddingDefault 0.0 _ppyRate totalLength + let (txns,_) = projScheduleCashflowByDefaultAmt + (begBal,begDate,begRate,begMbn) + (flowsWithEx,(expectedDefaultBals,unAppliedDefaultBals),ppyRates) -- `debug` ("exted flows"++ show flowsWithEx) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns amr) -- `debug` ("txn"++show txns) + let begBalAfterCut = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCut,asOfDay,Nothing) futureTxns) ,historyM) -- `debug` ("Future txn"++ show futureTxns) + + -- project current mortgage(without delinq) + projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current) + asOfDay + mars@(A.MortgageAssump amd amp amr ams ,_ ,_) + mRates = + let + recoveryLag = maybe 0 getRecoveryLag amr + lastPayDate:cfDates = lastN (rt + 1) $ sd:getPaymentDates m 0 + cfDatesLength = length cfDates + remainTerms = reverse [0..rt] + dc = getDayCount or -- `debug` ("day count"++ show dc) + recoveryDates = lastN recoveryLag $ sd:getPaymentDates m recoveryLag + in + do + rateVector <- A.projRates cr or mRates cfDates + defRates <- Ast.buildDefaultRates m (lastPayDate:cfDates) amd + ppyRates <- Ast.buildPrepayRates m (lastPayDate:cfDates) amp + let (txns',_,_) = projectMortgageFlow + (ob, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot) + (cfDates, defRates, ppyRates,rateVector,remainTerms) + let txns = DL.toList txns' + let lastProjTxn = last txns + let extraTxns = [ CF.emptyTsRow d lastProjTxn | d <- recoveryDates ] + + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery (txns++extraTxns) amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) + + -- project current mortgage(with delinq) + projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current) + asOfDay + mars@(A.MortgageDeqAssump amd amp amr ams + ,_ + ,_) + mRates = + let + (recoveryRate, recoveryLag) = Ast.getRecoveryLagAndRate amr + lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:getPaymentDates m (recoveryLag+defaultLag) + (_,defaultLag,defaultPct) = Ast.getDefaultDelinqAssump amd cfDates + cfDatesLength = length cfDates + recoveryLag + defaultLag + in + do + rateVector <- A.projRates cr or mRates cfDates + (ppyRates,delinqRates,(_,_),_,_) <- Ast.buildAssumptionPpyDelinqDefRecRate m (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams) + let txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector + (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot) + (replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay txns + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay, Nothing) futureTxns) ,historyM) + + -- project defaulted Mortgage + projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn (Defaulted (Just defaultedDate)) ) + asOfDay + (_,_,A.DefaultedRecovery rr lag timing) _ = + let + (emptyDates,recoveryDates) = splitAt (pred lag) $ genDates defaultedDate p (lag + length timing) + beforeRecoveryTxn = [ CF.MortgageFlow d 0 0 0 0 0 0 0 cr mbn Nothing Nothing | d <- emptyDates ] + recoveries = calcRecoveriesFromDefault cb rr timing + txns = [ CF.MortgageFlow d 0 0 0 0 0 r 0 cr mbn Nothing Nothing | (d,r) <- zip recoveryDates recoveries ] + futureTxns = cutBy Inc Future asOfDay $ beforeRecoveryTxn ++ txns + begBal = CF.buildBegBal futureTxns + in + Right $ (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns ,Map.empty) + + -- project defaulted adjMortgage with a defaulted Date + projCashflow m@(AdjustRateMortgage mo arm cb cr rt mbn (Defaulted (Just defaultedDate)) ) asOfDay assumps mRates + = projCashflow (Mortgage mo cb cr rt mbn (Defaulted (Just defaultedDate))) asOfDay assumps mRates + -- project defaulted adjMortgage without a defaulted Date + projCashflow m@(AdjustRateMortgage _ _ cb cr rt mbn (Defaulted Nothing) ) asOfDay assumps _ + = Right $ (CF.CashFlowFrame (cb,asOfDay,Nothing) [ CF.MortgageFlow asOfDay 0 0 0 0 0 0 0 cr mbn Nothing Nothing] ,Map.empty) + -- project defaulted Mortgage + projCashflow m@(Mortgage _ cb cr rt mbn (Defaulted Nothing) ) asOfDay assumps _ + = Right $ (CF.CashFlowFrame (cb,asOfDay,Nothing) [ CF.MortgageFlow asOfDay 0 0 0 0 0 0 0 cr mbn Nothing Nothing] ,Map.empty) + + -- project current AdjMortgage + projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current) + asOfDay + mars@(A.MortgageAssump amd amp amr ams,_,_) + mRates = + let + ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm + passInitPeriod = (ot - rt) >= initPeriod + firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) + (recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate amr + lastPayDate:cfDates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recoveryLag + 1) $ sd:getPaymentDates m recoveryLag + cfDatesLength = length cfDates -- `debug` (" cf dates >>" ++ show (last_pay_date:cf_dates )) + rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates + rateVector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve) + scheduleBalToday = calcScheduleBalaceToday m mRates asOfDay + dc = getDayCount or + in + do + (ppyRates,defRates,recoveryRate,recoveryLag) <- buildAssumptionPpyDefRecRate m (lastPayDate:cfDates) (A.MortgageAssump amd amp amr ams) + let remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt] + let (txns,_,_) = projectMortgageFlow (scheduleBalToday, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot) (cfDates, defRates, ppyRates,rateVector,remainTerms) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery (DL.toList txns) amr) + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) + + -- project current AdjMortgage with delinq + projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current) + asOfDay + mars@(A.MortgageDeqAssump amd amp amr ams,_,_) + mRates + = let + ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm + passInitPeriod = (ot - rt) >= initPeriod + firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) + (recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate amr + -- Ast.getDefaultDelinqAssump amd + lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:getPaymentDates m recoveryLag + (_,defaultLag,defaultPct) = Ast.getDefaultDelinqAssump amd cfDates + cfDatesLength = length cfDates + rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates + rateVector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve) + in + do + (ppyRates, delinqRates,(_,_),_,_) <- Ast.buildAssumptionPpyDelinqDefRecRate m (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams) + let txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector + (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot) + (replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0) + let (futureTxns,historyM)= CF.cutoffTrs asOfDay txns + let begBal = CF.buildBegBal futureTxns + return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM) + + -- schedule mortgage flow without delinq + projCashflow m@(ScheduleMortgageFlow begDate flows dp) asOfDay + assumps@(pAssump@(A.MortgageAssump _ _ mRa ams ),dAssump,fAssump) _ + = let + begBal = CF.mflowBegBalance $ head flows + endDate = CF.getDate (last flows) + (recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate mRa + curveDatesLength = recoveryLag + length flows + extraDates = genSerialDates dp Exc endDate recoveryLag + cfDates = (CF.getDate <$> flows) ++ extraDates + in + do + (ppyRates,defRates,recoveryRate,recoveryLag) <- buildAssumptionPpyDefRecRate m (begDate:cfDates) pAssump + let txns = projectScheduleFlow [] 1.0 begBal flows defRates ppyRates + (replicate curveDatesLength 0.0) + (replicate curveDatesLength 0.0) + (recoveryLag,recoveryRate) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns + let begBalAfterCutoff = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff,asOfDay,Nothing) futureTxns) ,historyM) + + -- schedule mortgage flow WITH delinq + projCashflow smf@(ScheduleMortgageFlow begDate flows dp) asOfDay assumps@(pAssump@(A.MortgageDeqAssump _ _ _ ams),dAssump,fAssump) mRates + = + let + begBal = CF.mflowBegBalance $ head flows -- `debug` ("beg date"++show beg_date) + in + do + (ppyRates, delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) <- Ast.buildAssumptionPpyDelinqDefRecRate smf (begDate:getDates flows) pAssump + let curveDatesLength = defaultLag + recoveryLag + length flows -- `debug` ("Length of rates"++show (length delinqRates)++">>"++show (length ppyRates)) + let extraPeriods = defaultLag + recoveryLag -- `debug` ("lags "++show defaultLag++">>"++show recoveryLag) + let endDate = CF.getDate (last flows) + let extraDates = genSerialDates dp Exc endDate extraPeriods + let extraFlows = [ CF.emptyTsRow d r | (d,r) <- zip extraDates (replicate extraPeriods (last flows)) ] + let flowWithExtraDates = flows ++ extraFlows + let cfDates = getDates flowWithExtraDates -- `debug` ("CF dates"++ show flowWithExtraDates) + let txns = projectScheduleDelinqFlow ([],[]) 1.0 begBal flowWithExtraDates delinqRates ppyRates + (replicate curveDatesLength 0.0) (replicate curveDatesLength 0.0) + (replicate curveDatesLength 0.0) (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("Delinq rates"++ show delinqRates++">>ppy rates"++ show ppyRates) + let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns + let begBalAfterCutoff = CF.buildBegBal futureTxns + return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff, asOfDay,Nothing) futureTxns) ,historyM) + + projCashflow a b c d = Left $ "Failed to match when proj mortgage with assumption >>" ++ show a ++ show b ++ show c ++ show d + + getBorrowerNum m@(Mortgage _ cb cr rt mbn _ ) = fromMaybe 1 mbn + getBorrowerNum m@(AdjustRateMortgage _ _ cb cr rt mbn _ ) = fromMaybe 1 mbn + + splitWith (Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn obr) cb cr rt mbn st ) rs + = [ Mortgage (MortgageOriginalInfo (mulBR ob ratio) or ot p sd prinPayType mpn obr) (mulBR cb ratio) cr rt mbn st + | ratio <- rs ] + + splitWith (AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn obr) arm cb cr rt mbn st ) rs + = [ AdjustRateMortgage (MortgageOriginalInfo (mulBR ob ratio) or ot p sd prinPayType mpn obr) arm (mulBR cb ratio) cr rt mbn st + | ratio <- rs ] + + diff --git a/src/AssetClass/ProjectedCashFlow.hs b/src/AssetClass/ProjectedCashFlow.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/ProjectedCashFlow.hs @@ -0,0 +1,223 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module AssetClass.ProjectedCashFlow + (ProjectedCashflow(..)) + where + +import qualified Data.Time as T +import qualified Assumptions as A +import Asset as Ast +import Types +import Lib +import Util +import DateUtil +import InterestRate as IR + +import qualified Data.Map as Map +import Data.List +import Data.Ratio +import Data.Maybe +import GHC.Generics +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types + +import qualified Cashflow as CF + +import AssetClass.AssetBase +import AssetClass.AssetCashflow + +import Cashflow (extendTxns,TsRow(..)) + +import Debug.Trace +import Control.Lens hiding (element,Index) +import Control.Lens.TH +debug = flip trace + + +projectScheduleFlow :: [CF.TsRow] -> Rate -> Balance -> [CF.TsRow] -> [DefaultRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> (Int, Rate) -> [CF.TsRow] +projectScheduleFlow trs _ last_bal [] _ _ [] [] (_,_) = trs +projectScheduleFlow trs bal_factor last_bal (flow:flows) (defRate:defRates) (ppyRate:ppyRates) recV lossV (recoveryLag,recoveryRate) + = projectScheduleFlow (trs++[tr]) surviveRate endBal flows defRates ppyRates (tail recVector) (tail lossVector) (recoveryLag,recoveryRate) -- `debug` ("===>C") + where + startBal = last_bal + defAmt = mulBR startBal defRate + ppyAmt = mulBR (startBal - defAmt) ppyRate + afterBal = startBal - defAmt - ppyAmt + + surviveRate = (1 - defRate) * (1 - ppyRate) * bal_factor + schedulePrin = mulBR (CF.mflowPrincipal flow) surviveRate --TODO round trip -- `debug` ("Schedule Principal"++(printf "%.2f" (CF.mflowPrincipal flow))++" Rate"++show(_schedule_rate)) + scheduleInt = mulBR (CF.mflowInterest flow) surviveRate + + newRec = mulBR defAmt recoveryRate + newLoss = mulBR defAmt (1 - recoveryRate) + + recVector = replace recV recoveryLag newRec + lossVector = replace lossV recoveryLag newLoss + + endBal = max 0 $ afterBal - schedulePrin -- `debug` ("start bal"++ show startBal ++"sch prin"++ show schedulePrin) + + tr = CF.MortgageFlow (CF.getDate flow) endBal schedulePrin scheduleInt ppyAmt defAmt (head recVector) (head lossVector) 0.0 Nothing Nothing Nothing--TODO missing ppy-penalty here + +projectScheduleFlow trs b_factor lastBal [] _ _ (r:rs) (l:ls) (recovery_lag,recovery_rate) + = projectScheduleFlow (trs++[tr]) b_factor lastBal [] [] [] rs ls (recovery_lag - 1,recovery_rate) + where + remain_length = length rs + lastDate = CF.getDate (last trs) + flowDate = nextDate lastDate Lib.Monthly + tr = CF.MortgageFlow flowDate lastBal 0 0 0 0 r l 0.0 Nothing Nothing Nothing + + + +-- ^ project cashflow with floater rate portion +projFixCfwithAssumption :: (CF.CashFlowFrame, DatePattern) -> ([Rate],[Rate],Rate,Int) -> Date -> Either String CF.CashFlowFrame +projFixCfwithAssumption (cf@(CF.CashFlowFrame (begBal, begDate, accInt) flows), dp) + (ppyRates,defRates,recoveryRate,recoveryLag) + asOfDay + = let + curveDatesLength = recoveryLag + length flows + endDate = CF.getDate (last flows) + extraDates = genSerialDates dp Exc endDate recoveryLag + cfDates = (CF.getDate <$> flows) ++ extraDates + in + do + let txns = projectScheduleFlow [] 1.0 begBal flows defRates ppyRates + (replicate curveDatesLength 0.0) + (replicate curveDatesLength 0.0) + (recoveryLag,recoveryRate) -- `debug` (" begin bal"++ show begBal) + + let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns + + let cb = (CF.mflowBegBalance . head) futureTxns + return $ CF.CashFlowFrame (cb,asOfDay,Nothing) futureTxns + +-- ^ project cashflow with fix rate portion +projIndexCashflows :: ([Date],[Balance],[Principal],Index,Spread) -> DatePattern -> ([Rate],[Rate],Rate,Int) -> Maybe [RateAssumption] -> Either String CF.CashFlowFrame +projIndexCashflows (ds,bals,principals,index,spd) dp pAssump (Just ras) = + do + -- mIndexToApply = A.getRateAssumption ras index + indexRates <- sequenceA $ A.lookupRate0 ras index <$> ds + + let rates = (spd +) <$> indexRates + let interestFlow = zipWith (flip mulBIR) rates bals + let flowSize = length bals + let scheduleCf = CF.CashFlowFrame (head bals, head ds, Nothing) $ + zipWith12 MortgageFlow + ds + bals + principals + interestFlow + (replicate flowSize 0 ) + (replicate flowSize 0 ) + (replicate flowSize 0 ) + (replicate flowSize 0 ) + rates + (replicate flowSize Nothing) + (replicate flowSize Nothing) + (replicate flowSize Nothing) + projFixCfwithAssumption (scheduleCf, dp) pAssump (head ds) + +-- ^ project cashflow with fix rate portion and floater rate portion +seperateCashflows :: ProjectedCashflow -> Maybe A.AssetPerfAssumption -> Maybe [RateAssumption] -> Either String (CF.CashFlowFrame, [CF.CashFlowFrame]) +seperateCashflows a@(ProjectedFlowMixFloater pflow@(CF.CashFlowFrame (begBal, begDate, accuredInt) flows) dp (fixPct,fixRate) floaterList) + mPassump + mRates + = let + begBal = CF.mflowBegBalance $ head flows + totalBals = begBal: ((view CF.tsRowBalance) <$> flows) + ds = (view CF.tsDate) <$> flows + flowSize = length ds + -- fix rate cashflow + -- fix balance = total balance * fix percent + fixedBals = flip mulBR fixPct <$> totalBals + -- fix principal flow = total principal flow * fix percent + fixedPrincipalFlow = flip mulBR fixPct <$> CF.mflowPrincipal <$> flows + -- fix principal interest = total principal flow * fix rate + fixedInterestFlow = flip mulBIR fixRate <$> fixedBals + fixFlow = zipWith12 MortgageFlow ds fixedBals fixedPrincipalFlow fixedInterestFlow (replicate flowSize 0) (replicate flowSize 0) (replicate flowSize 0) (replicate flowSize 0) (replicate flowSize fixRate) (replicate flowSize Nothing) (replicate flowSize Nothing) (replicate flowSize Nothing) + -- float rate cashflow + -- float balance = total balance - fixed balance + totalFloatBalFlow = zipWith (-) totalBals fixedBals + -- float principal flow = total principal flow - fixed principal flow + floatPrincipalFlow = zipWith (-) (CF.mflowPrincipal <$> flows) fixedPrincipalFlow + + rs = (\(a,b,c) -> a) <$> floaterList -- portion of each floater + spds = (\(a,b,c) -> b) <$> floaterList -- spreads + indexes = (\(a,b,c) -> c) <$> floaterList -- indexes + floaterSize = length rs + -- float bal brekdown by index + floatBalsBreakDown = (\r -> flip mulBR r <$> totalFloatBalFlow ) <$> rs + -- float principal flow breakdown by index + floatPrincipalFlowBreakDown = (\r -> flip mulBR r <$> floatPrincipalFlow) <$> rs -- `debug` ("float bal breakdown"++ show floatBalsBreakDown) + recoveryLag = case mPassump of + Nothing -> 0 + Just passump -> fromMaybe 0 $ getRecoveryLagFromAssumption passump + curveDatesLength = length flows + recoveryLag + in + do + assumptionInput <- case mPassump of + Just pAssump -> buildAssumptionPpyDefRecRate a (begDate:ds) pAssump + Nothing -> Right (replicate curveDatesLength 0.0, replicate curveDatesLength 0.0, 0.0, 0) + fixedCashFlow <- projFixCfwithAssumption ((CF.CashFlowFrame ( ((flip mulBR) fixPct) begBal + , begDate + , (flip mulBR) fixPct <$> accuredInt) + fixFlow) + , dp) assumptionInput begDate + floatedCashFlow <- sequenceA $ (\x -> projIndexCashflows x dp assumptionInput mRates) <$> zip5 + (replicate floaterSize ds) + floatBalsBreakDown + floatPrincipalFlowBreakDown + indexes + spds + return (fixedCashFlow, floatedCashFlow) -- `debug` ("float cf"++ show floatedCashFlow) + + + +instance Ast.Asset ProjectedCashflow where + + getCurrentBal (ProjectedFlowFixed cf@(CF.CashFlowFrame (begBal,_,_) _) _) = begBal + getCurrentBal (ProjectedFlowMixFloater cf@(CF.CashFlowFrame (begBal,_,_) _) _ _ _) = begBal + + getOriginBal x = getCurrentBal x + getOriginRate x = 0.0 + + isDefaulted f = error "" + getOriginDate f = error "" + getOriginInfo f = error "" + + getCurrentRate f = 0.0 + + calcCashflow f@(ProjectedFlowFixed cf _) d _ = Right $ cf + + calcCashflow f@(ProjectedFlowMixFloater cf _ fxPortion floatPortion) d mRate + = do + (fixedCashFlow, floatedCashFlow) <- seperateCashflows f Nothing mRate -- `debug` ("running fixed cashflow"++show fixedCashFlow) + return $ foldl CF.combine fixedCashFlow floatedCashFlow + + projCashflow f@(ProjectedFlowFixed cf dp) asOfDay (pAssump,_,_) mRates + = do + let cfDates = CF.getDatesCashFlowFrame cf + let begDate = view (CF.cfBeginStatus . _2) cf + pRates <- buildAssumptionPpyDefRecRate f (begDate:cfDates) pAssump + p <- projFixCfwithAssumption (cf, dp) pRates asOfDay + return (p, Map.empty) + + projCashflow f asOfDay (pAssump, _, _) mRates + = do + (fixedCashFlow, floatedCashFlow) <- seperateCashflows f (Just pAssump) mRates + return $ (foldl CF.combine fixedCashFlow floatedCashFlow, Map.empty) + --(fixedCashFlow, Map.empty) + + projCashflow a b c d = Left $ "Failed to match when proj projected flow with assumption >>" ++ show a ++ show b ++ show c ++ show d + + getBorrowerNum f = 0 + + splitWith f rs = [f] + +-- instance IR.UseRate ProjectedCashflow where +-- isAdjustbleRate _ = False +-- getIndex _ = Nothing +-- getIndexes _ = Nothing diff --git a/src/AssetClass/Receivable.hs b/src/AssetClass/Receivable.hs new file mode 100644 --- /dev/null +++ b/src/AssetClass/Receivable.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module AssetClass.Receivable + () + where + +import qualified Data.Time as T +import qualified Cashflow as CF +import qualified Assumptions as A +import Asset as Ast +import Types +import Lib +import Util +import DateUtil +import InterestRate as IR + +import qualified Data.Map as Map +import Data.List +import Data.Ratio +import Data.Maybe +import GHC.Generics +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types + +import AssetClass.AssetBase +import AssetClass.AssetCashflow +import Debug.Trace +import Assumptions (AssetPerfAssumption(ReceivableAssump)) +import GHC.Float.RealFracMethods (truncateFloatInteger) +import Cashflow (extendTxns) +import qualified Asset as A + +debug = flip trace + +-- 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 + 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 +calcDueFactorFee r@(Invoice (ReceivableInfo sd ob oa dd ft obr) st) asOfDay + = case ft of + Nothing -> 0 + Just (FixedFee b) -> b + 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 + in + 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] + in + sum $ (`calcDueFactorFee` asOfDay) <$> newReceivables + + +instance Asset Receivable where + + getPaymentDates r@(Invoice (ReceivableInfo sd ob oa dd ft _) st) _ = [dd] + + calcCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) st) asOfDay _ + = Right $ CF.CashFlowFrame (ob,asOfDay,Nothing) $ cutBy Inc Future asOfDay txns + where + payDate = dd + feeDue = calcDueFactorFee r payDate + initTxn = CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing + + feePaid = min ob feeDue + principal = max 0 $ ob - feeDue + + txns = [initTxn,CF.ReceivableFlow payDate 0 0 principal feePaid 0 0 0 Nothing] + + getCurrentBal r@(Invoice (ReceivableInfo sd ob oa dd ft _) st) = ob + + isDefaulted r@(Invoice (ReceivableInfo sd ob oa dd ft _) Current) = False + isDefaulted r@(Invoice (ReceivableInfo sd ob oa dd ft _) _) = True + + getOriginDate r@(Invoice (ReceivableInfo sd ob oa dd ft _) st) = sd + + resetToOrig r@(Invoice (ReceivableInfo sd ob oa dd ft _) st) = r + + getRemainTerms r@(Invoice (ReceivableInfo sd ob oa dd ft _) st) = 1 + + getOriginRate _ = 0 + getCurrentRate _ = 0 + + updateOriginDate r@(Invoice (ReceivableInfo sd ob oa dd ft obr) st) newDate + = let + gaps = daysBetween sd dd + in + 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 ] + + -- Defaulted Invoice + projCashflow r@(Invoice (ReceivableInfo sd ob oa dd ft _) (Defaulted _)) + asOfDay + massump@(A.ReceivableAssump _ amr ams, _ , _) + mRates + = Right $ (CF.CashFlowFrame (ob,asOfDay,Nothing) futureTxns, historyM) + where + payDate = dd + initTxn = CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing + txns = [initTxn, CF.ReceivableFlow asOfDay 0 0 0 0 ob 0 ob Nothing] + (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr) + + + -- 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 + = 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] + 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, _ , _) + mRates + = let + payDate = dd + feeDue = calcDueFactorFee r payDate + initTxn = CF.ReceivableFlow sd ob 0 0 0 0 0 0 Nothing + in + do + 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 feePaid = min afterDefaultBal afterDefaultFee + let principal = max 0 $ afterDefaultBal - feePaid + + let realizedLoss = case amr of + Nothing -> defaultAmt + Just _ -> 0 + + let txns = [initTxn, CF.ReceivableFlow payDate 0 0 principal feePaid defaultAmt 0 realizedLoss Nothing] + 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 new file mode 100644 --- /dev/null +++ b/src/Assumptions.hs @@ -0,0 +1,359 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} + +module Assumptions (BondPricingInput(..),IrrType(..) + ,AssumptionInput(..),ApplyAssumptionType(..) + ,lookupAssumptionByIdx,lookupRate,AssetPerfAssumption(..) + ,ExtraStress(..),RevolvingAssumption(..) + ,AssetPrepayAssumption(..),AssetDefaultAssumption(..),RecoveryAssumption(..) + ,getRateAssumption,projRates,lookupRate0 + ,LeaseAssetGapAssump(..) + ,LeaseAssetRentAssump(..) + ,NonPerfAssumption(..),AssetPerf + ,AssetDelinquencyAssumption(..) + ,AssetDelinqPerfAssumption(..),AssetDefaultedPerfAssumption(..) + ,IssueBondEvent(..) + ,TagMatchRule(..),ObligorStrategy(..),RefiEvent(..),InspectType(..) + ,FieldMatchRule(..),CallOpt(..) + ,_MortgageAssump,_MortgageDeqAssump,_LeaseAssump,_LoanAssump,_InstallmentAssump + ,_ReceivableAssump,_FixedAssetAssump + ,stressDefaultAssump,applyAssumptionTypeAssetPerf,TradeType(..) + ,LeaseEndType(..),LeaseDefaultType(..),stressPrepaymentAssump,StopBy(..) + ) +where + +import Call as C +import Lib (Ts(..),TsPoint(..),toDate,mkRateTs) +import Liability (Bond,InterestInfo) +import Util +import DateUtil +import qualified Data.Map as Map +import Data.List +import qualified Data.Set as Set +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import Types +import qualified Data.Time as T +import Data.Fixed +import Data.Ratio +import Revolving +import GHC.Generics +import AssetClass.AssetBase +import Debug.Trace +import InterestRate +import Control.Lens hiding (Index) + +debug = flip trace + +type AssetPerf = (AssetPerfAssumption,AssetDelinqPerfAssumption,AssetDefaultedPerfAssumption) +type StratPerfByIdx = ([Int],AssetPerf) + +lookupAssumptionByIdx :: [StratPerfByIdx] -> Int -> Either String AssetPerf +lookupAssumptionByIdx sbi i + = case find (\(indxs,_) -> Set.member i (Set.fromList indxs) ) sbi of + Just (_, aps ) -> Right aps + Nothing -> Left ("Lookup assumption by ID: Can't find idx"++ show i ++"in starfication list"++ show sbi) + +type ObligorTagStr = String + +data TagMatchRule = TagEq -- ^ match exactly + | TagSubset -- ^ match subset + | TagSuperset -- ^ match superset + | TagAny -- ^ match any tag hit + | TagNot TagMatchRule -- ^ Negative match + deriving (Show, Generic, Read) + +data FieldMatchRule = FieldIn String [String] + | FieldCmp String Cmp Double + | FieldInRange String RangeType Double Double + | FieldNot FieldMatchRule + deriving (Show, Generic, Read) + +data ObligorStrategy = ObligorById [String] AssetPerf + | ObligorByTag [ObligorTagStr] TagMatchRule AssetPerf + | ObligorByField [FieldMatchRule] AssetPerf + | ObligorByDefault AssetPerf + deriving (Show, Generic, Read) + +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 + | 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) + + +applyAssumptionTypeAssetPerf :: Traversal' ApplyAssumptionType AssetPerf +applyAssumptionTypeAssetPerf f = go + where + go (PoolLevel x) = PoolLevel <$> f x + go (ByIndex strats) = ByIndex <$> traverse (\(idxs,aps) -> (idxs,) <$> f aps) strats + go (ByName m) = ByName <$> traverse f m + go (ByObligor os) = ByObligor <$> traverse (\case + ObligorById ids ap -> ObligorById ids <$> f ap + ObligorByTag tags m ap -> ObligorByTag tags m <$> f ap + ObligorByField fs ap -> ObligorByField fs <$> f ap + ObligorByDefault ap -> ObligorByDefault <$> f ap + ) os + go (ByPoolId m) = ByPoolId <$> traverse go m + go (ByDealName m) = ByDealName <$> traverse (\(a,b) -> (,) <$> go a <*> pure b) m + + +type RateFormula = DealStats +type BalanceFormula = DealStats + +data IssueBondEvent = IssueBondEvent (Maybe Pre) BondName AccName Bond (Maybe BalanceFormula) (Maybe RateFormula) + | FundingBondEvent (Maybe Pre) BondName AccName Balance + deriving (Show, Generic, Read) + +data RefiEvent = RefiRate AccountName BondName InterestInfo + | RefiBond AccountName Bond + | RefiEvents [RefiEvent] + deriving (Show, Generic, Read) + +data InspectType = InspectPt DatePattern DealStats + | InspectRpt DatePattern [DealStats] + deriving (Show, Generic, Read) + +data CallOpt = LegacyOpts [C.CallOption] -- ^ legacy support + | CallPredicate [Pre] -- ^ default test call for each pay day, keep backward compatible + | 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 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 + ,interest :: Maybe [RateAssumption] -- ^ optional interest rates assumptions + ,inspectOn :: Maybe [InspectType] -- ^ optional tuple list to inspect variables during waterfall run + ,buildFinancialReport :: Maybe DatePattern -- ^ optional dates to build financial reports + ,pricing :: Maybe BondPricingInput -- ^ optional bond pricing input( discount curve etc) + ,fireTrigger :: Maybe [(Date,DealCycle,String)] -- ^ optional fire a trigger + ,makeWholeWhen :: Maybe (Date,Spread,Table Float Spread) + ,issueBondSchedule :: Maybe [TsPoint IssueBondEvent] + ,refinance :: Maybe [TsPoint RefiEvent] +} deriving (Show, Generic) + +data AssumptionInput = Single ApplyAssumptionType NonPerfAssumption -- ^ one assumption request + | Multiple (Map.Map String ApplyAssumptionType) NonPerfAssumption -- ^ multiple assumption request in a single request + deriving (Show,Generic) + +data AssetDefaultAssumption = DefaultConstant Rate -- ^ using constant default rate + | DefaultCDR Rate -- ^ using annualized default rate + | DefaultVec [Rate] -- ^ using default rate vector + | DefaultVecPadding [Rate] -- ^ using default rate vector, but padding with last rate till end + | DefaultByAmt (Balance,[Rate]) + | DefaultAtEnd -- ^ default 100% at end + | DefaultAtEndByRate Rate Rate -- ^ life time default rate and default rate at end + | DefaultStressByTs Ts AssetDefaultAssumption + | DefaultByTerm [[Rate]] + deriving (Show,Generic,Read) + +-- ^ stress the default assumption by a factor +stressDefaultAssump :: Rate -> AssetDefaultAssumption -> AssetDefaultAssumption +stressDefaultAssump x (DefaultConstant r) = DefaultConstant $ min 1.0 (r*x) +stressDefaultAssump x (DefaultCDR r) = DefaultCDR $ min 1.0 (r*x) +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 (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 + | PrepaymentCPR Rate + | PrepaymentVec [Rate] + | PrepaymentVecPadding [Rate] + | PrepayByAmt (Balance,[Rate]) + | PrepayStressByTs Ts AssetPrepayAssumption + | PrepaymentPSA Rate + | PrepaymentByTerm [[Rate]] + deriving (Show,Generic,Read) + +data AssetDelinquencyAssumption = DelinqCDR Rate (Lag,Rate) -- ^ Annualized Rate to Delinq status , period lag become defaulted, loss rate, period lag become loss + | DelinqByAmt (Balance,[Rate]) (Lag,Rate) + | Dummy3 + deriving (Show,Generic,Read) + +data RecoveryAssumption = Recovery (Rate,Int) -- ^ recovery rate, recovery lag + | RecoveryTiming (Rate,[Rate]) -- ^ recovery rate, with distribution of recoveries + | RecoveryByDays Rate [(Int, Rate)] -- ^ recovery rate, with distribution of recoveries by offset dates + deriving (Show,Generic,Read) + +data LeaseAssetGapAssump = GapDays Int -- ^ days between leases, when creating dummy leases + | GapDaysByCurve Ts -- ^ days depends on the size of leases, when a default a default days for size greater + deriving (Show,Generic,Read) + +data LeaseAssetRentAssump = BaseAnnualRate Rate + | BaseCurve Ts + | BaseByVec [Rate] + deriving (Show,Generic,Read) + +data LeaseDefaultType = DefaultByContinuation Rate + | DefaultByTermination Rate + deriving (Show,Generic,Read) + + +data LeaseEndType = CutByDate Date + | StopByExtTimes Int + | EarlierOf Date Int + | LaterOf Date Int + deriving (Show,Generic,Read) + +data ExtraStress = ExtraStress { + defaultFactors :: Maybe Ts -- ^ stress default rate via a time series based factor curve + ,prepaymentFactors :: Maybe Ts -- ^ stress prepayment rate via a time series based factor curve + ,poolHairCut :: Maybe [(PoolSource, Rate)] -- ^ haircut on pool income source + } deriving (Show,Generic,Read) + +type ExtendCashflowDates = DatePattern + +data AssetDefaultedPerfAssumption = DefaultedRecovery Rate Int [Rate] + | DummyDefaultAssump + deriving (Show,Generic,Read) + +data AssetDelinqPerfAssumption = DummyDelinqAssump + deriving (Show,Generic,Read) + + + +data AssetPerfAssumption = MortgageAssump (Maybe AssetDefaultAssumption) (Maybe AssetPrepayAssumption) (Maybe RecoveryAssumption) (Maybe ExtraStress) + | MortgageDeqAssump (Maybe AssetDelinquencyAssumption) (Maybe AssetPrepayAssumption) (Maybe RecoveryAssumption) (Maybe ExtraStress) + | LeaseAssump (Maybe LeaseDefaultType) LeaseAssetGapAssump LeaseAssetRentAssump LeaseEndType + | LoanAssump (Maybe AssetDefaultAssumption) (Maybe AssetPrepayAssumption) (Maybe RecoveryAssumption) (Maybe ExtraStress) + | InstallmentAssump (Maybe AssetDefaultAssumption) (Maybe AssetPrepayAssumption) (Maybe RecoveryAssumption) (Maybe ExtraStress) + | ReceivableAssump (Maybe AssetDefaultAssumption) (Maybe RecoveryAssumption) (Maybe ExtraStress) + | FixedAssetAssump Ts Ts (Maybe Int) -- util rate, price, (Maybe extend periods) + deriving (Show,Generic,Read) + + +data RevolvingAssumption = AvailableAssets RevolvingPool ApplyAssumptionType + | AvailableAssetsBy (Map.Map String (RevolvingPool, ApplyAssumptionType)) + deriving (Show,Generic) + +type HistoryCash = [(Date,Amount)] +type CurrentHolding = Balance -- as of the deal date +type PricingDate = Date +type AmountToBuy = Balance + + +data TradeType = ByCash Balance + | ByBalance Balance + deriving (Show,Generic) + +data IrrType = HoldingBond HistoryCash CurrentHolding (Maybe (Date, BondPricingMethod)) + | BuyBond Date BondPricingMethod TradeType (Maybe (Date, BondPricingMethod)) + deriving (Show,Generic) + + +data BondPricingInput = DiscountCurve PricingDate Ts + -- ^ PV curve used to discount bond cashflow and a PV date where cashflow discounted to + | RunZSpread Ts (Map.Map BondName (Date,Rational)) + -- ^ PV curve as well as bond trading price with a deal used to calc Z - spread + | DiscountRate PricingDate Rate + -- | OASInput Date BondName Balance [Spread] (Map.Map String Ts) -- ^ only works in multiple assumption request + | IrrInput (Map.Map BondName IrrType) + -- ^ IRR calculation for a list of bonds + deriving (Show,Generic) + + +getIndexFromRateAssumption :: RateAssumption -> Index +getIndexFromRateAssumption (RateCurve idx _) = idx +getIndexFromRateAssumption (RateFlat idx _) = idx + +-- ^ lookup rate from rate assumption with index and spread +lookupRate :: [RateAssumption] -> Floater -> Date -> Either String IRate +lookupRate rAssumps (index,spd) d + = case find (\x -> getIndexFromRateAssumption x == index ) rAssumps of + Just (RateCurve _ ts) -> Right $ spd + fromRational (getValByDate ts Inc d) + Just (RateFlat _ r) -> Right $ r + spd + Nothing -> Left $ "Failed to find Index " ++ show index ++ "in list "++ show rAssumps + +-- ^ lookup rate from rate assumption with index +lookupRate0 :: [RateAssumption] -> Index -> Date -> Either String IRate +lookupRate0 rAssumps index d + = case find (\x -> getIndexFromRateAssumption x == index ) rAssumps of + Just (RateCurve _ ts) -> Right $ fromRational (getValByDate ts Inc d) + Just (RateFlat _ r) -> Right r + Nothing -> Left $ "Failed to find Index " ++ show index ++ " from Rate Assumption" ++ show rAssumps + + +getRateAssumption :: [RateAssumption] -> Index -> Maybe RateAssumption +getRateAssumption assumps idx + = find (\case + (RateCurve _idx _) -> idx == _idx + (RateFlat _idx _) -> idx == _idx + _ -> False) + assumps + +-- | 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 + = case getRateAssumption assumps idx of + Nothing -> Left ("Failed to find index rate " ++ show idx ++ " from "++ show assumps) + Just _rateAssumption -> + Right $ + let + resetDates = genSerialDatesTill2 NO_IE (head ds) dp (last ds) + ratesFromCurve = case _rateAssumption of + (RateCurve _ ts) -> (\x -> spd + (fromRational x) ) <$> (getValByDates ts Inc resetDates) + (RateFlat _ v) -> (spd +) <$> replicate (length resetDates) v + ratesUsedByDates = getValByDates + (mkRateTs $ zip ((head ds):resetDates) (sr:ratesFromCurve)) + Inc + ds + in + case (rfloor,rcap) of + (Nothing, Nothing) -> fromRational <$> ratesUsedByDates + (Just fv, Just cv) -> capWith cv $ floorWith fv $ fromRational <$> ratesUsedByDates + (Just fv, Nothing) -> floorWith fv $ fromRational <$> ratesUsedByDates + (Nothing, Just cv) -> capWith cv $ fromRational <$> ratesUsedByDates + +projRates _ rt rassump ds = Left ("Invalid rate type: "++ show rt++" assump: "++ show rassump) + + +-- ^ Given a list of rates, calcualte whether rates was reset + +makePrisms ''AssetPerfAssumption +makePrisms ''AssetDefaultAssumption + +$(deriveJSON defaultOptions ''CallOpt) +$(deriveJSON defaultOptions ''TradeType) +$(deriveJSON defaultOptions ''IrrType) +$(deriveJSON defaultOptions ''BondPricingInput) +$(deriveJSON defaultOptions ''IssueBondEvent) +$(deriveJSON defaultOptions ''RefiEvent) + + + +$(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/Call.hs b/src/Call.hs new file mode 100644 --- /dev/null +++ b/src/Call.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module Call(CallOption(..)) + where + +import qualified Data.Time as T +import Lib +import Types +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import GHC.Generics + +data CallOption = PoolBalance Balance -- ^ triggered when pool perform balance below threshold + | BondBalance Balance -- ^ triggered when bond current balance below threshold + | PoolFactor Rate -- ^ triggered when pool factor (pool perform balance/origin balance) + | BondFactor Rate -- ^ triggered when bond factor (total bonds current balance / origin balance) + | OnDate Date -- ^ triggered at date + | AfterDate Date -- ^ triggered when after date + | And [CallOption] -- ^ triggered when all options were satisfied + | Or [CallOption] -- ^ triggered when any option is satisfied + | PoolPv Balance -- ^ Call when PV of pool fall below + | Pre Pre -- ^ triggered when predicate evaluates to be True + deriving (Show,Generic,Ord,Eq,Read) + +$(deriveJSON defaultOptions ''CallOption) diff --git a/src/Cashflow.hs b/src/Cashflow.hs new file mode 100644 --- /dev/null +++ b/src/Cashflow.hs @@ -0,0 +1,1179 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DataKinds #-} + +module Cashflow (CashFlowFrame(..),Principals,Interests,Amount + ,combine,mergePoolCf,sumTsCF,tsSetLoss,tsSetRecovery + ,sizeCashFlowFrame,aggTsByDates,emptyCashFlowFrame + ,mflowInterest,mflowPrincipal,mflowRecovery,mflowPrepayment + ,mflowRental,mflowRate,sumPoolFlow,splitTrs,aggregateTsByDate + ,mflowDefault,mflowLoss + ,getDatesCashFlowFrame + ,lookupSource,lookupSourceM,combineTss + ,mflowBegBalance,tsDefaultBal + ,mflowBorrowerNum,mflowPrepaymentPenalty,tsRowBalance + ,emptyTsRow,mflowAmortAmount + ,tsTotalCash, setPrepaymentPenalty, setPrepaymentPenaltyFlow + ,getDate,getTxnLatestAsOf,totalPrincipal + ,mflowWeightAverageBalance,tsDate + ,totalLoss,totalDefault,totalRecovery,firstDate + ,shiftCfToStartDate,cfInsertHead,buildBegTsRow,insertBegTsRow + ,tsCumDefaultBal,tsCumDelinqBal,tsCumLossBal,tsCumRecoveriesBal + ,TsRow(..),cfAt,cutoffTrs,patchCumulative,extendTxns,dropTailEmptyTxns + ,cashflowTxn,clawbackInt,scaleTsRow,mflowFeePaid, currentCumulativeStat, patchCumulativeAtInit + ,mergeCf,buildStartTsRow + ,txnCumulativeStats,consolidateCashFlow, cfBeginStatus, getBegBalCashFlowFrame + ,splitCashFlowFrameByDate, mergePoolCf2, buildBegBal, extendCashFlow, patchBalance + ,splitPoolCashflowByDate + ,getAllDatesCashFlowFrame,splitCf, cutoffCashflow + ,AssetCashflow,PoolCashflow + ,emptyCashflow,isEmptyRow2 + ) where + +import Data.Time (Day) +import Data.Fixed +import Lib (weightedBy,toDate,getIntervalFactors,daysBetween,paySeqLiabilitiesAmt) +import Util (mulBR,mulBInt,mulIR,lastOf) +import DateUtil ( splitByDate ) +import Types +import qualified Data.Map as Map +import qualified Data.Time as T +import qualified Data.List as L +import Data.Maybe + +import Data.Aeson hiding (json) +import Language.Haskell.TH +import GHC.Generics +import Data.Aeson.TH +import Data.Aeson.Types +import Text.Printf + +import Debug.Trace +import qualified Control.Lens as Map +import Control.Applicative (liftA2) +import Data.OpenApi (HasPatch(patch), HasXml (xml)) +import Control.DeepSeq (NFData,rnf) +import Data.Text.Internal.Encoding.Fusion (streamUtf16BE) + +import qualified Text.Tabular as TT +import qualified Text.Tabular.AsciiArt as A +import Control.Lens hiding (element) +import Control.Lens.TH + +debug = flip trace + +type Delinquent = Balance +type Amounts = [Float] +type Principals = [Principal] +type Interests = [Interest] +type Prepayments = [Prepayment] +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) +opStats op Nothing Nothing = Nothing +opStats op (Just a) Nothing = Just a +opStats op Nothing (Just a) = Just a + +sumStats :: Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat +-- sumStats (a1,b1,c1,d1,e1,f1) (a2,b2,c3,d2,e2,f2) = (a1+a2,b1+b2,c1+c3,d1+d2,e1+e2,f1+f2) +sumStats s1 s2 = opStats (+) s1 s2 + +subStats :: Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat +-- subStats (a1,b1,c1,d1,e1,f1) (a2,b2,c3,d2,e2,f2) = (a1-a2,b1-b2,c1-c3,d1-d2,e1-e2,f1-f2) +subStats s1 s2 = opStats (-) s1 s2 + +maxStats :: Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat +-- maxStats (a1,b1,c1,d1,e1,f1) (a2,b2,c3,d2,e2,f2) = (max a1 a2,max b1 b2,max c1 c3,max d1 d2,max e1 e2,max f1 f2) +maxStats s1 s2 = opStats max s1 s2 + +splitStats :: Rational -> CumulativeStat -> CumulativeStat +splitStats r st1@(a1,b1,c1,d1,e1,f1) = ((`mulBR` r) a1,(`mulBR` r) b1,(`mulBR` r) c1,(`mulBR` r) d1,(`mulBR` r) e1,(`mulBR` r) f1) + +type Depreciation = Balance +type NewDepreciation = Balance +type AccuredFee = Balance +type FeePaid = Balance + +startOfTime = T.fromGregorian 1900 1 1 + +data TsRow = CashFlow Date Amount + | BondFlow Date Balance Principal Interest + | MortgageFlow Date Balance Principal Interest Prepayment Default Recovery Loss IRate (Maybe BorrowerNum) (Maybe PrepaymentPenalty) (Maybe CumulativeStat) + | MortgageDelinqFlow Date Balance Principal Interest Prepayment Delinquent Default Recovery Loss IRate (Maybe BorrowerNum) (Maybe PrepaymentPenalty) (Maybe CumulativeStat) + | LoanFlow Date Balance Principal Interest Prepayment Default Recovery Loss IRate (Maybe CumulativeStat) + | LeaseFlow Date Balance Rental Default + | FixedFlow Date Balance NewDepreciation Depreciation Balance Balance -- unit cash + | ReceivableFlow Date Balance AccuredFee Principal FeePaid Default Recovery Loss (Maybe CumulativeStat) + deriving(Show,Eq,Ord,Generic,NFData) + +instance Semigroup TsRow where + CashFlow d1 a1 <> (CashFlow d2 a2) = CashFlow (max d1 d2) (a1 + a2) + BondFlow d1 b1 p1 i1 <> (BondFlow d2 b2 p2 i2) = BondFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) + MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1 <> MortgageFlow d2 b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2 st2 + = MortgageFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (liftA2 (+) mbn1 mbn2) (liftA2 (+) pn1 pn2) (sumStats st1 st2) + MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 st1 <> MortgageDelinqFlow d2 b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2 st2 + = MortgageDelinqFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (delinq1 + delinq2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (liftA2 (+) mbn1 mbn2) (liftA2 (+) pn1 pn2) (sumStats st1 st2) + LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1 <> LoanFlow d2 b2 p2 i2 prep2 def2 rec2 los2 rat2 st2 + = LoanFlow (max d1 d2) (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1 + los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (sumStats st1 st2) + LeaseFlow d1 b1 r1 def1 <> LeaseFlow d2 b2 r2 def2 + = LeaseFlow (max d1 d2) (b1 + b2) (r1 + r2) (def1 + def2) + FixedFlow d1 b1 ndep1 dep1 c1 a1 <> FixedFlow d2 b2 ndep2 dep2 c2 a2 + = FixedFlow (max d1 d2) (b1 + b2) (ndep1 + ndep2) (dep1 + dep2) (c1 + c2) (a1 + a2) + ReceivableFlow d1 b1 af1 p1 fp1 def1 rec1 los1 st1 <> ReceivableFlow d2 b2 af2 p2 fp2 def2 rec2 los2 st2 + = ReceivableFlow (max d1 d2) (b1 + b2) (af1 + af2) (p1 + p2) (fp1 + fp2) (def1 + def2) (rec1 + rec2) (los1 + los2) (sumStats st1 st2) + a <> b = error $ "TsRow Semigroup not supported "++show a++" "++show b + + +instance TimeSeries TsRow where + getDate (CashFlow x _) = x + getDate (BondFlow x _ _ _) = x + getDate (MortgageFlow x _ _ _ _ _ _ _ _ _ _ _) = x + getDate (MortgageDelinqFlow x _ _ _ _ _ _ _ _ _ _ _ _) = x + getDate (LoanFlow x _ _ _ _ _ _ _ _ _) = x + getDate (LeaseFlow x _ _ _) = x + getDate (FixedFlow x _ _ _ _ _ ) = x + getDate (ReceivableFlow x _ _ _ _ _ _ _ _) = x + + +scaleTsRow :: Rational -> TsRow -> TsRow +scaleTsRow r (CashFlow d a) = CashFlow d (fromRational r * a) +scaleTsRow r (BondFlow d b p i) = BondFlow d (fromRational r * b) (fromRational r * p) (fromRational r * i) +scaleTsRow r (MortgageFlow d b p i prep def rec los rat mbn pp st) + = MortgageFlow d + (fromRational r * b) + (fromRational r * p) + (fromRational r * i) + (fromRational r * prep) + (fromRational r * def) + (fromRational r * rec) + (fromRational r * los) + rat + mbn + pp + (splitStats r <$> st) +scaleTsRow r (MortgageDelinqFlow d b p i prep delinq def rec los rat mbn pp st) + = MortgageDelinqFlow d + (fromRational r * b) + (fromRational r * p) + (fromRational r * i) + (fromRational r * prep) + (fromRational r * delinq) + (fromRational r * def) + (fromRational r * rec) + (fromRational r * los) + rat + mbn + pp + (splitStats r <$> st) +scaleTsRow r (LoanFlow d b p i prep def rec los rat st) + = LoanFlow d (fromRational r * b) (fromRational r * p) (fromRational r * i) (fromRational r * prep) (fromRational r * def) (fromRational r * rec) (fromRational r * los) rat ((splitStats r) <$> st) +scaleTsRow r (LeaseFlow d b rental def) = LeaseFlow d (fromRational r * b) (fromRational r * rental) (fromRational r * def) +scaleTsRow r (FixedFlow d b ndep dep c a) = FixedFlow d (fromRational r * b) (fromRational r * ndep) (fromRational r * dep) (fromRational r * c) (fromRational r * a) +scaleTsRow r (ReceivableFlow d b af p fp def rec los st) = ReceivableFlow d (fromRational r * b) (fromRational r * af) (fromRational r * p) (fromRational r * fp) (fromRational r * def) (fromRational r * rec) (fromRational r * los) ((splitStats r) <$> st) + + +type BeginBalance = Balance +type AccuredInterest = Maybe Balance +type BeginDate = Date +type BeginStatus = (BeginBalance, BeginDate, AccuredInterest) + +data CashFlowFrame = CashFlowFrame BeginStatus [TsRow] + | MultiCashFlowFrame (Map.Map String [CashFlowFrame]) + deriving (Eq,Generic,Ord) + +cfBeginStatus :: Lens' CashFlowFrame BeginStatus +cfBeginStatus = lens getter setter + where + getter (CashFlowFrame st _) = st + setter (CashFlowFrame _ tsRows) st = CashFlowFrame st tsRows + + +instance Show CashFlowFrame where + show (CashFlowFrame st []) = "Empty CashflowFrame"++ show st + -- show (CashFlowFrame st txns) = concat $ L.intersperse "\n" [ show txn | txn <- txns ] + show (CashFlowFrame st txns) = + let + ds = [ show d | d <- getDates txns] + rowHeader = [TT.Header h | h <- ds ] + getCs (CashFlow {}) = ["Amount"] + getCs (BondFlow {}) = ["Balance", "Principal", "Interest"] + getCs (MortgageFlow {}) = ["Balance", "Principal", "Interest", "Prepayment", "Default", "Recovery", "Loss", "IRate", "BorrowerNum", "PrepaymentPenalty", "CumulativeStat"] + getCs (MortgageDelinqFlow {}) = [ "Balance", "Principal", "Interest", "Prepayment", "Delinquent", "Default", "Recovery", "Loss", "IRate", "BorrowerNum", "PrepaymentPenalty", "CumulativeStat"] + getCs (LoanFlow {}) = ["Balance", "Principal", "Interest", "Prepayment", "Default", "Recovery", "Loss", "IRate", "CumulativeStat"] + getCs (LeaseFlow {}) = [ "Balance", "Rental", "Default"] + getCs (FixedFlow {}) = [ "Balance", "NewDepreciation", "Depreciation", "Balance", "Amount"] + getCs (ReceivableFlow {}) = [ "Balance", "AccuredFee", "Principal", "FeePaid", "Default", "Recovery", "Loss", "CumulativeStat"] + colHeader = [TT.Header c | c <- getCs (head txns) ] + getRs (CashFlow d a) = [show a] + getRs (BondFlow d b p i) = [ show b, show p, show i] + getRs (MortgageFlow d b p i prep def rec los rat mbn pp st) = [ show b, show p, show i, show prep, show def, show rec, show los, show rat, show mbn, show pp, show st] + getRs (MortgageDelinqFlow d b p i prep delinq def rec los rat mbn pp st) = [ show b, show p, show i, show prep, show delinq, show def, show rec, show los, show rat, show mbn, show pp, show st] + getRs (LoanFlow d b p i prep def rec los rat st) = [ show b, show p, show i, show prep, show def, show rec, show los, show rat, show st] + getRs (LeaseFlow d b r def) = [ show b, show r, show def] + getRs (FixedFlow d b ndep dep c a) = [ show b, show ndep, show dep, show c, show a] + getRs (ReceivableFlow d b af p fp def rec los st) = [ show b, show af, show p, show fp, show def, show rec, show los, show st] + values = [ getRs txn | txn <- txns ] + tbl = TT.Table (TT.Group TT.SingleLine rowHeader) (TT.Group TT.SingleLine colHeader) values + in + show st <> "\n" <> A.render id id id tbl + +instance NFData CashFlowFrame where + rnf (CashFlowFrame st txns) = rnf st `seq` rnf txns + rnf (MultiCashFlowFrame m) = rnf m + +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 + +getAllDatesCashFlowFrame :: CashFlowFrame -> [Date] +getAllDatesCashFlowFrame (CashFlowFrame (_,d,_) ts) = d : getDates ts + +getBegBalCashFlowFrame :: CashFlowFrame -> Balance +getBegBalCashFlowFrame (CashFlowFrame _ []) = 0 +getBegBalCashFlowFrame (CashFlowFrame _ (cf:cfs)) = mflowBegBalance cf + +cfAt :: CashFlowFrame -> Int -> Maybe TsRow +cfAt (CashFlowFrame _ trs) idx + | (idx < 0) || (idx >= length trs) = Nothing + | otherwise = Just (trs!!idx) + +cfInsertHead :: TsRow -> CashFlowFrame -> CashFlowFrame +cfInsertHead tr (CashFlowFrame st trs) = CashFlowFrame st $ tr:trs + + +splitCashFlowFrameByDate :: CashFlowFrame -> Date -> SplitType -> (CashFlowFrame,CashFlowFrame) +splitCashFlowFrameByDate (CashFlowFrame status txns) d st + = let + (ls,rs) = splitByDate txns d st + newStatus = case rs of + [] -> (0, d, Nothing) + (r:_) -> (mflowBegBalance r, 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 = (\xs -> fst <$> xs ) <$> assetCfs + rAssetCfs = (\xs -> snd <$> xs ) <$> assetCfs + in + ((lPoolCF, lAssetCfs) , (rPoolCF, rAssetCfs)) + + + +getTxnLatestAsOf :: CashFlowFrame -> Date -> Maybe TsRow +getTxnLatestAsOf (CashFlowFrame _ txn) d = L.find (\x -> getDate x <= d) $ reverse txn + +addTs :: TsRow -> TsRow -> TsRow +-- ^ left cashflow is ealier ,right one is later,combine both and yield cashflow with earlier date +addTs (CashFlow d1 a1 ) (CashFlow _ a2 ) = CashFlow d1 (a1 + a2) +addTs (BondFlow d1 b1 p1 i1 ) tr@(BondFlow _ b2 p2 i2 ) = BondFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) +addTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2 st2) + = let + bn = (+) <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + st = sumStats st1 st2 + in + MortgageFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st +addTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@(MortgageDelinqFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2 st2) + = let + bn = (+) <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + delinq = (+) delinq1 delinq2 + st = sumStats st1 st2 + in + MortgageDelinqFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st + +addTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1) tr@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 st2) + = LoanFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (sumStats st1 st2) + +addTs (LeaseFlow d1 b1 r1 def1) tr@(LeaseFlow d2 b2 r2 def2) + = LeaseFlow d1 (b1 - mflowAmortAmount tr) (r1 + r2) (def1 + def2) + +addTs (ReceivableFlow d1 b1 af1 p1 fp1 def1 rec1 los1 st1) tr@(ReceivableFlow _ b2 af2 p2 fp2 def2 rec2 los2 st2) + = ReceivableFlow d1 (b1 - mflowAmortAmount tr) (af1 + af2) (p1 + p2) (fp1 + fp2) (def1 + def2) (rec1 + rec2) (los1 + los2) (sumStats st1 st2) + +combineTs :: TsRow -> TsRow -> TsRow + +-- ^ combine two cashflow records from two entities, return cashflow with earlier date +combineTs (CashFlow d1 a1 ) (CashFlow _ a2 ) = CashFlow d1 (a1 + a2) + +combineTs (BondFlow d1 b1 p1 i1 ) tr@(BondFlow _ b2 p2 i2 ) = BondFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) + +combineTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@(MortgageDelinqFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2 st2) + = let + bn = (+) <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + delinq = (+) delinq1 delinq2 + st = sumStats st1 st2 + in + MortgageDelinqFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st + +combineTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1) tr@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2 st2) + = let + bn = (+) <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + st = sumStats st1 st2 + in + MortgageFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st + +combineTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1) tr@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 st2) + = LoanFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (sumStats st1 st2) + +combineTs (LeaseFlow d1 b1 r1 def1) tr@(LeaseFlow d2 b2 r2 def2) + = LeaseFlow d1 (b1 + b2) (r1 + r2) (def1 + def2) + +combineTs (FixedFlow d1 b1 de1 cde1 p1 c1 ) (FixedFlow d2 b2 de2 cde2 p2 c2) + = FixedFlow d1 (b1+b2) (de1+de2) (cde1+cde2) (p1+p2) (c1+c2) + +combineTs (ReceivableFlow d1 b1 af1 p1 fp1 def1 rec1 los1 st1) tr@(ReceivableFlow _ b2 af2 p2 fp2 def2 rec2 los2 st2) + = ReceivableFlow d1 (b1 + b2) (af1 + af2) (p1 + p2) (fp1 + fp2) (def1 + def2) (rec1 + rec2) (los1 + los2) (sumStats st1 st2) + +-- ^ combine two cashflows from two entities,(auto patch a beg balance) +-- ^ left cashflow is ealier ,right one is later,combine both and yield cashflow with earlier date +combineTss :: [TsRow] -> [TsRow] -> [TsRow] -> [TsRow] +combineTss [] [] r = r +combineTss [] r [] = r +combineTss [] (r1:r1s) (r2:r2s) + | getDate r1 > getDate r2 = combineTss [] (r2:r2s) (r1:r1s) + | getDate r1 == getDate r2 = combineTss [combineTs r1 r2] r1s r2s -- `debug` ("combineTss after same"++show r1s++" "++show r2s) + | otherwise = combineTss [set tsRowBalance (mflowBegBalance r2+(view tsRowBalance r1)) r1] + r1s + (r2:r2s) + +combineTss consols [] [] = reverse consols +combineTss (consol:consols) (r:rs) [] = combineTss (appendTs consol r:consol:consols) rs [] +combineTss (consol:consols) [] (tr:trs) = combineTss (appendTs consol tr:consol:consols) [] trs +combineTss (consol:consols) (r:rs) (tr:trs) + | getDate r == getDate tr = combineTss (appendTs consol (combineTs r tr):consol:consols) rs trs + | getDate r < getDate tr = combineTss (appendTs consol r:consol:consols) rs (tr:trs) + | getDate r > getDate tr = combineTss (appendTs consol tr:consol:consols) (r:rs) trs +combineTss a b c = error $ "combineTss not supported "++show a++" "++show b++" "++show c + + + +appendTs :: TsRow -> TsRow -> TsRow +-- ^ combine two cashflow records from two entities ,(early row on left, later row on right) +appendTs bn1@(BondFlow d1 b1 _ _ ) bn2@(BondFlow d2 b2 p2 i2 ) + = set tsRowBalance (b1 - mflowAmortAmount bn2) bn2 -- `debug` ("b1 >> "++show b1++">>"++show (mflowAmortAmount bn2)) +appendTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 _ def1 rec1 los1 rat1 mbn1 _ mstat1) bn2@(MortgageDelinqFlow _ b2 p2 i2 prep2 _ def2 rec2 los2 rat2 mbn2 _ mstat2) + = set tsRowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs bn1@(MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 _ mstat1) bn2@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 _ mstat2) + = set tsRowBalance (b1 - mflowAmortAmount bn2) bn2 -- `debug` ("Summing stats"++ show bn1 ++ show mstat1++">>"++ show bn2 ++ show mstat2) +appendTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mstat1) bn2@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mstat2) + = set tsRowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs (LeaseFlow d1 b1 r1 def1) bn2@(LeaseFlow d2 b2 r2 def2) + = set tsRowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs (FixedFlow d1 b1 de1 cde1 p1 c1 ) bn2@(FixedFlow d2 b2 de2 cde2 p2 c2) + = set tsRowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs (ReceivableFlow d1 b1 af1 p1 fp1 def1 rec1 los1 mstat1) bn2@(ReceivableFlow _ b2 af2 p2 fp2 def2 rec2 los2 mstat2) + = set tsRowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs _1 _2 = error $ "appendTs failed with "++ show _1 ++ ">>" ++ show _2 + +-- ^ add up TsRow from same entity +addTsCF :: TsRow -> TsRow -> TsRow +addTsCF (CashFlow d1 a1 ) (CashFlow _ a2 ) = CashFlow d1 (a1 + a2) +addTsCF (BondFlow d1 b1 p1 i1 ) (BondFlow _ b2 p2 i2 ) = BondFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) +addTsCF m1@(MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1 st1) m2@(MortgageFlow d2 b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2 st2) + = let + bn = min <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + st = maxStats st1 st2 + in + MortgageFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st +addTsCF (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1 st1) (MortgageDelinqFlow d2 b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2 st2) + = let + bn = min <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + delinq = (+) delinq1 delinq2 + st = maxStats st1 st2 + in + MortgageDelinqFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) bn p st +addTsCF (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 st1) (LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 st2) + = LoanFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy (toRational <$> [b1,b2]) (toRational <$> [rat1,rat2]))) (maxStats st1 st2) +addTsCF (LeaseFlow d1 b1 r1 def1) (LeaseFlow d2 b2 r2 def2) = LeaseFlow d1 (min b1 b2) (r1 + r2) (def1 + def2) +addTsCF (FixedFlow d1 b1 dep1 cd1 u1 c1) (FixedFlow d2 b2 dep2 cd2 u2 c2) + = FixedFlow d1 (min b1 b2) (dep1 + dep2) (cd1 + cd2) u2 (c1 + c2) +addTsCF (ReceivableFlow d1 b1 af1 p1 fp1 def1 rec1 los1 st1) (ReceivableFlow d2 b2 af2 p2 fp2 def2 rec2 los2 st2) + = ReceivableFlow d1 (min b1 b2) (af1 + af2) (p1 + p2) (fp1 + fp2) (def1 + def2) (rec1 + rec2) (los1 + los2) (maxStats st1 st2) + + +buildBegBal :: [TsRow] -> Balance +buildBegBal [] = 0 +buildBegBal (x:_) = mflowBegBalance x + + +sumTs :: [TsRow] -> Date -> TsRow +sumTs trs d = set tsDate d (foldr1 addTs trs) + +-- ^ group cashflow from same entity by a single date +sumTsCF :: [TsRow] -> Date -> TsRow +-- sumTsCF [] = tsSetDate (foldl1 addTsCF trs) -- `debug` ("Summing"++show trs++">>"++ show (tsSetDate (foldr1 addTsCF trs) d)) +sumTsCF [] _ = error "sumTsCF failed with empty list" +sumTsCF trs d = set tsDate d (foldl1 addTsCF trs) -- `debug` ("Summing"++show trs++">>"++ show (tsSetDate (foldr1 addTsCF trs) d)) + +tsTotalCash :: TsRow -> Balance +tsTotalCash (CashFlow _ x) = x +tsTotalCash (BondFlow _ _ a b) = a + b +tsTotalCash (MortgageDelinqFlow x _ a b c _ _ e _ _ _ mPn _ ) = a + b + c + e + fromMaybe 0 mPn +tsTotalCash (MortgageFlow x _ a b c _ e _ _ _ mPn _) = a + b + c + e + fromMaybe 0 mPn +tsTotalCash (LoanFlow _ _ a b c _ e _ _ _) = a + b + c + e +tsTotalCash (LeaseFlow _ _ a _) = a +tsTotalCash (FixedFlow _ _ _ _ _ x) = x +tsTotalCash (ReceivableFlow _ _ _ a b _ c _ _ ) = a + b + c + +tsDefaultBal :: TsRow -> Either String Balance +tsDefaultBal CashFlow {} = Left "no default amount for bond flow" +tsDefaultBal BondFlow {} = Left "no default amount for bond flow" +tsDefaultBal (MortgageDelinqFlow _ _ _ _ _ _ x _ _ _ _ _ _) = Right x +tsDefaultBal (MortgageFlow _ _ _ _ _ x _ _ _ _ _ _) = Right x +tsDefaultBal (LoanFlow _ _ _ _ _ x _ _ _ _) = Right x +tsDefaultBal (LeaseFlow _ _ _ x) = Right x +tsDefaultBal (FixedFlow _ _ x _ _ _) = Right x +tsDefaultBal (ReceivableFlow _ _ _ _ _ x _ _ _ ) = Right x + +tsCumulative :: Lens' TsRow (Maybe CumulativeStat) +tsCumulative = lens getter setter + where + getter (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ _ _ _ mStat) = mStat + getter (MortgageFlow _ _ _ _ _ _ _ _ _ _ _ mStat) = mStat + getter (LoanFlow _ _ _ _ _ _ _ _ _ mStat) = mStat + getter (ReceivableFlow _ _ _ _ _ _ _ _ mStat) = mStat + getter _ = Nothing + + setter (MortgageDelinqFlow a b c d e f g h i j k l _) mStat = MortgageDelinqFlow a b c d e f g h i j k l mStat + setter (MortgageFlow a b c d e f g h i j k _) mStat = MortgageFlow a b c d e f g h i j k mStat + setter (LoanFlow a b c d e f g h i _) mStat = LoanFlow a b c d e f g h i mStat + setter (ReceivableFlow a b c d e f g h _) mStat = ReceivableFlow a b c d e f g h mStat + setter x _ = x + +tsCumDefaultBal :: TsRow -> Maybe Balance +tsCumDefaultBal tr = preview (tsCumulative . _Just . _4) tr + +tsCumDelinqBal :: TsRow -> Maybe Balance +tsCumDelinqBal tr = preview (tsCumulative . _Just . _3) tr + +tsCumLossBal :: TsRow -> Maybe Balance +tsCumLossBal tr = preview (tsCumulative . _Just . _6) tr + +tsCumRecoveriesBal :: TsRow -> Maybe Balance +tsCumRecoveriesBal tr = preview (tsCumulative . _Just . _5) tr + +tsDate :: Lens' TsRow Date +tsDate = lens getter setter + where + getter (CashFlow x _) = x + getter (BondFlow x _ _ _) = x + getter (MortgageDelinqFlow x _ _ _ _ _ _ _ _ _ _ _ _) = x + getter (MortgageFlow x _ _ _ _ _ _ _ _ _ _ _) = x + getter (LoanFlow x _ _ _ _ _ _ _ _ _) = x + getter (LeaseFlow x _ _ _ ) = x + getter (FixedFlow x _ _ _ _ _) = x + getter (ReceivableFlow x _ _ _ _ _ _ _ _) = x + setter (CashFlow _ a) x = CashFlow x a + setter (BondFlow _ a b c) x = BondFlow x a b c + setter (MortgageDelinqFlow _ a b c d e f g h i j k l) x = MortgageDelinqFlow x a b c d e f g h i j k l + setter (MortgageFlow _ a b c d e f g h i j k) x = MortgageFlow x a b c d e f g h i j k + setter (LoanFlow _ a b c d e f g h i) x = LoanFlow x a b c d e f g h i + setter (LeaseFlow _ a b c) x = LeaseFlow x a b c + setter (FixedFlow _ a b c d e) x = FixedFlow x a b c d e + setter (ReceivableFlow _ a b c d e f g h) x = ReceivableFlow x a b c d e f g h + +tsSetLoss :: Balance -> TsRow -> TsRow +tsSetLoss x (MortgageDelinqFlow _d a b c d e f g h i j k l) = MortgageDelinqFlow _d a b c d e f g x i j k l +tsSetLoss x (MortgageFlow _d a b c d e f g h i j k) = MortgageFlow _d a b c d e f x h i j k +tsSetLoss x (LoanFlow _d a b c d e f g h i) = LoanFlow _d a b c d e f x h i +tsSetLoss x (ReceivableFlow _d a b c d e f g h) = ReceivableFlow _d a b c d e f x h +tsSetLoss x _ = error $ "Failed to set Loss for "++show x + +tsSetRecovery :: Balance -> TsRow -> TsRow +tsSetRecovery x (MortgageDelinqFlow _d a b c d e f g h i j k l) = MortgageDelinqFlow _d a b c d e f x h i j k l +tsSetRecovery x (MortgageFlow _d a b c d e f g h i j k) = MortgageFlow _d a b c d e x g h i j k +tsSetRecovery x (LoanFlow _d a b c d e f g h i) = LoanFlow _d a b c d e x g h i +tsSetRecovery x (ReceivableFlow _d a b c d e f g h) = ReceivableFlow _d a b c d e x g h +tsSetRecovery x _ = error $ "Failed to set Recovery for "++show x + +tsOffsetDate :: Integer -> TsRow -> TsRow +tsOffsetDate x (CashFlow _d a) = CashFlow (T.addDays x _d) a +tsOffsetDate x (BondFlow _d a b c) = BondFlow (T.addDays x _d) a b c +tsOffsetDate x (MortgageDelinqFlow _d a b c d e f g h i j k l) = MortgageDelinqFlow (T.addDays x _d) a b c d e f g h i j k l +tsOffsetDate x (MortgageFlow _d a b c d e f g h i j k) = MortgageFlow (T.addDays x _d) a b c d e f g h i j k +tsOffsetDate x (LoanFlow _d a b c d e f g h i) = LoanFlow (T.addDays x _d) a b c d e f g h i +tsOffsetDate x (LeaseFlow _d a b c) = LeaseFlow (T.addDays x _d) a b c +tsOffsetDate x (ReceivableFlow _d a b c d e f g h) = ReceivableFlow (T.addDays x _d) a b c d e f g h + +tsReduceInt :: Balance -> TsRow -> TsRow +tsReduceInt x (BondFlow _d a b c) = BondFlow _d a b (c-x) +tsReduceInt x (MortgageDelinqFlow _d a b c d e f g h i j k l) = MortgageDelinqFlow _d a b (c-x) d e f g h i j k l +tsReduceInt x (MortgageFlow _d a b c d e f g h i j k) = MortgageFlow _d a b (c-x) d e f g h i j k +tsReduceInt x (LoanFlow _d a b c d e f g h i) = LoanFlow _d a b (c-x) d e f g h i +tsReduceInt _ x = error $ "Failed to reduce interest on asset "++ show x + +-- ^ claw back interest from cashflow records +clawbackInt :: Balance -> [TsRow] -> [TsRow] +clawbackInt bal txns + = let + intFlow = mflowInterest <$> txns + intDowns = paySeqLiabilitiesAmt bal intFlow + in + [ tsReduceInt intDown txn | (txn,intDown) <- zip txns intDowns] + +aggregateTsByDate :: [TsRow] -> [TsRow] -> [TsRow] +aggregateTsByDate rs [] = reverse rs +aggregateTsByDate [] (tr:trs) = aggregateTsByDate [tr] trs +aggregateTsByDate (r:rs) (tr:trs) + | sameDate r tr = aggregateTsByDate (combineTs r tr:rs) trs + | otherwise = aggregateTsByDate (tr:r:rs) trs + + +firstDate :: CashFlowFrame -> Date +firstDate (CashFlowFrame _ []) = error "empty cashflow frame to get first date" +firstDate (CashFlowFrame _ [r]) = getDate r +firstDate (CashFlowFrame _ (r:rs)) = getDate r + + +-- ! combine two cashflow frames from two entities +-- ! cashflow earlier on the left ,later cashflow on the right +combine :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame +combine (CashFlowFrame st1 []) (CashFlowFrame st2 []) = CashFlowFrame st1 [] +combine (CashFlowFrame _ []) cf2 = cf2 +combine cf1 (CashFlowFrame _ []) = cf1 +combine cf1@(CashFlowFrame st1@(begBal1,begDate1,acc1) txn1) cf2@(CashFlowFrame st2@(begBal2,begDate2,acc2) txn2) + | begDate1 > begDate2 = combine cf2 cf1 + | otherwise = + let + txns = combineTss [] txn1 txn2 + in + CashFlowFrame (begBal1,begDate1,acc1) txns + +buildCollectedCF :: [[TsRow]] -> [Date] -> [TsRow] -> [[TsRow]] +buildCollectedCF [] [] [] = [] +buildCollectedCF trs [] _trs = trs +buildCollectedCF trs ds [] = trs ++ [ [viewTsRow _d ((last . last) trs)] | _d <- ds ] +buildCollectedCF trs (d:ds) _trs = + case newFlow of + [] -> case Util.lastOf trs (not . null) of + Nothing -> buildCollectedCF (trs++[[]]) ds _trs -- `debug` ("empty trs"++ show d) + Just lastTr -> buildCollectedCF (trs++[[viewTsRow d (last lastTr)]]) ds _trs -- `debug` ("non empty last tr "++ show lastTr ++ "for date"++ show d++"insert with "++show (viewTsRow d (last lastTr))) + newFlow -> buildCollectedCF (trs++[newFlow]) ds remains + where + (newFlow, remains) = splitBy d Inc _trs + +buildCollectedCF a b c = error $ "buildCollectedCF failed"++ show a++">>"++ show b++">>"++ show c + + +aggTsByDates :: [TsRow] -> [Date] -> [TsRow] +aggTsByDates [] ds = [] +aggTsByDates trs ds = uncurry sumTsCF <$> filter (\(cfs,_d) -> (not . null) cfs) (zip (buildCollectedCF [] ds trs) ds) -- `debug` (">>> to sumTsCF "++ show (zip (buildCollectedCF [] ds trs) ds )) + +mflowPrincipal :: TsRow -> Balance +mflowPrincipal (BondFlow _ _ p _) = p +mflowPrincipal (MortgageFlow _ _ x _ _ _ _ _ _ _ _ _) = x +mflowPrincipal (MortgageDelinqFlow _ _ x _ _ _ _ _ _ _ _ _ _) = x +mflowPrincipal (LoanFlow _ _ x _ _ _ _ _ _ _) = x +mflowPrincipal (ReceivableFlow _ _ _ x _ _ _ _ _) = x +mflowPrincipal _ = error "not supported" + +mflowInterest :: TsRow -> Balance +mflowInterest (BondFlow _ _ _ i) = i +mflowInterest (MortgageDelinqFlow _ _ _ x _ _ _ _ _ _ _ _ _) = x +mflowInterest (MortgageFlow _ _ _ x _ _ _ _ _ _ _ _) = x +mflowInterest (LoanFlow _ _ _ x _ _ _ _ _ _) = x +mflowInterest x = error $ "not supported: getting interest from row" ++ show x + +mflowPrepayment :: TsRow -> Balance +mflowPrepayment (MortgageFlow _ _ _ _ x _ _ _ _ _ _ _) = x +mflowPrepayment (MortgageDelinqFlow _ _ _ _ x _ _ _ _ _ _ _ _) = x +mflowPrepayment (LoanFlow _ _ _ _ x _ _ _ _ _) = x +mflowPrepayment _ = error "not supported" + +mflowDefault :: TsRow -> Balance +mflowDefault (MortgageFlow _ _ _ _ _ x _ _ _ _ _ _) = x +mflowDefault (MortgageDelinqFlow _ _ _ _ _ _ x _ _ _ _ _ _) = x +mflowDefault (LoanFlow _ _ _ _ _ x _ _ _ _) = x +mflowDefault (FixedFlow _ _ x _ _ _) = x +mflowDefault (ReceivableFlow _ _ _ _ _ x _ _ _ ) = x +mflowDefault _ = 0 + +mflowRecovery :: TsRow -> Balance +mflowRecovery (MortgageFlow _ _ _ _ _ _ x _ _ _ _ _) = x +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 +tsRowBalance = lens getter setter + where + getter (BondFlow _ x _ _) = x + getter (MortgageFlow _ x _ _ _ _ _ _ _ _ _ _) = x + getter (MortgageDelinqFlow _ x _ _ _ _ _ _ _ _ _ _ _) = x + getter (LoanFlow _ x _ _ _ _ _ _ _ _) = x + getter (LeaseFlow _ x _ _) = x + getter (FixedFlow _ x _ _ _ _) = x + getter (ReceivableFlow _ x _ _ _ _ _ _ _ ) = x + + setter (BondFlow a _ p i) x = BondFlow a x p i + setter (MortgageFlow a _ p i prep def rec los rat mbn pn st) x = MortgageFlow a x p i prep def rec los rat mbn pn st + setter (MortgageDelinqFlow a _ p i prep delinq def rec los rat mbn pn st) x = MortgageDelinqFlow a x p i prep delinq def rec los rat mbn pn st + setter (LoanFlow a _ p i prep def rec los rat st) x = LoanFlow a x p i prep def rec los rat st + setter (LeaseFlow a _ r def) x = LeaseFlow a x r def + setter (FixedFlow a _ b c d e) x = FixedFlow a x b c d e + setter (ReceivableFlow a _ b c d e f g h) x = ReceivableFlow a x b c d e f g h + + +mflowBegBalance :: TsRow -> Balance +mflowBegBalance (BondFlow _ x p _) = x + p +mflowBegBalance (MortgageDelinqFlow _ x p _ ppy delinq def _ _ _ _ _ _) = x + p + ppy + delinq +mflowBegBalance (MortgageFlow _ x p _ ppy def _ _ _ _ _ _) = x + p + ppy + def +mflowBegBalance (LoanFlow _ x p _ ppy def _ _ _ _) = x + p + ppy + def +mflowBegBalance (LeaseFlow _ b r def ) = b + r + def +mflowBegBalance (FixedFlow a b c d e f ) = b + c +mflowBegBalance (ReceivableFlow _ x _ b f def _ _ _) = x + b + def + f + +mflowLoss :: TsRow -> Balance +mflowLoss (MortgageFlow _ _ _ _ _ _ _ x _ _ _ _) = x +mflowLoss (MortgageDelinqFlow _ _ _ _ _ _ _ _ x _ _ _ _) = x +mflowLoss (LoanFlow _ _ _ _ _ _ _ x _ _) = x +mflowLoss (ReceivableFlow _ _ _ _ _ _ _ x _ ) = x +mflowLoss _ = 0 + +mflowDelinq :: TsRow -> Balance +mflowDelinq (MortgageDelinqFlow _ _ _ _ _ x _ _ _ _ _ _ _) = x +mflowDelinq _ = 0 + +mflowRate :: TsRow -> IRate +-- ^ get rate(weigthed avg rate) for a cashflow record +mflowRate (MortgageFlow _ _ _ _ _ _ _ _ x _ _ _) = x +mflowRate (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ x _ _ _) = x +mflowRate (LoanFlow _ _ _ _ _ _ _ _ x _) = x +mflowRate (BondFlow _ _ _ _) = 0 +mflowRate _ = 0 + +mflowRental :: TsRow -> Amount +mflowRental (LeaseFlow _ _ x _) = x +mflowRental x = error ("not support get rental from row"++show x) + +mflowFeePaid :: TsRow -> Amount +mflowFeePaid (ReceivableFlow _ _ _ _ x _ _ _ _ ) = x +mflowFeePaid _ = 0 + +mflowAmortAmount :: TsRow -> Balance +-- ^ calculate amortized amount for cashflow (for defaults only) +mflowAmortAmount (MortgageFlow _ _ p _ ppy def _ _ _ _ _ _) = p + ppy + def +mflowAmortAmount (MortgageDelinqFlow _ _ p _ ppy delinq _ _ _ _ _ _ _) = p + ppy + delinq +mflowAmortAmount (LoanFlow _ _ x _ y z _ _ _ _) = x + y + z +mflowAmortAmount (LeaseFlow _ _ x def) = x + def +mflowAmortAmount (FixedFlow _ _ x _ _ _) = x +mflowAmortAmount (BondFlow _ _ p i) = p +mflowAmortAmount (ReceivableFlow _ _ _ x f def _ _ _ ) = x + def + f + +mflowBorrowerNum :: TsRow -> Maybe BorrowerNum +-- ^ get borrower numfer for Mortgage Flow +mflowBorrowerNum (MortgageFlow _ _ _ _ _ _ _ _ _ x _ _) = x +mflowBorrowerNum (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ _ x _ _) = x +mflowBorrowerNum _ = undefined + +mflowPrepaymentPenalty :: TsRow -> Balance +-- ^ get prepayment penalty for a cashflow record +mflowPrepaymentPenalty (MortgageFlow _ _ _ _ _ _ _ _ _ _ (Just x) _) = x +mflowPrepaymentPenalty (MortgageFlow _ _ _ _ _ _ _ _ _ _ Nothing _) = 0 +mflowPrepaymentPenalty (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ _ _ (Just x) _) = x +mflowPrepaymentPenalty (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ _ _ Nothing _) = 0 +mflowPrepaymentPenalty _ = undefined + +-- tobe factor out alongside with similar funciton in bond cashflow +mflowWeightAverageBalance :: Date -> Date -> [TsRow] -> Balance +mflowWeightAverageBalance sd ed trs + = sum $ zipWith mulBR _bals _dfs -- `debug` ("CalcingAvgBal=>"++show sd++show ed++show txns ) + where + txns = filter (\x -> (view tsDate x >=sd)&& (view tsDate x)<=ed) trs + _ds = view tsDate <$> txns -- `debug` ("fee base txns"++show txns) + _bals = map mflowBegBalance txns + _dfs = getIntervalFactors $ sd:_ds + +emptyTsRow :: Date -> TsRow -> TsRow +-- ^ reset all cashflow fields to zero and init with a date +emptyTsRow _d (MortgageDelinqFlow a x c d e f g h i j k l m) = MortgageDelinqFlow _d 0 0 0 0 0 0 0 0 0 Nothing Nothing Nothing +emptyTsRow _d (MortgageFlow a x c d e f g h i j k l) = MortgageFlow _d 0 0 0 0 0 0 0 0 Nothing Nothing Nothing +emptyTsRow _d (LoanFlow a x c d e f g i j k) = LoanFlow _d 0 0 0 0 0 0 0 0 Nothing +emptyTsRow _d (LeaseFlow a x c d) = LeaseFlow _d 0 0 0 +emptyTsRow _d (FixedFlow a x c d e f ) = FixedFlow _d 0 0 0 0 0 +emptyTsRow _d (BondFlow a x c d) = BondFlow _d 0 0 0 +emptyTsRow _d (ReceivableFlow a x c d e f g h i) = ReceivableFlow _d 0 0 0 0 0 0 0 Nothing + +extendCashFlow :: Date -> CashFlowFrame -> CashFlowFrame +extendCashFlow d (CashFlowFrame st []) = CashFlowFrame st [] +extendCashFlow d (CashFlowFrame st txns) + = let + lastRow = last txns + newTxn = emptyTsRow d lastRow + in + CashFlowFrame st (txns++[newTxn]) + + +viewTsRow :: Date -> TsRow -> TsRow +-- ^ take a snapshot of a record from record balance/stats and a new date +viewTsRow _d (MortgageDelinqFlow a b c d e f g h i j k l m) = MortgageDelinqFlow _d b 0 0 0 0 0 0 0 j k l m +viewTsRow _d (MortgageFlow a b c d e f g h i j k l) = MortgageFlow _d b 0 0 0 0 0 0 i j k l +viewTsRow _d (LoanFlow a b c d e f g i j k) = LoanFlow _d b 0 0 0 0 0 0 j k +viewTsRow _d (LeaseFlow a b c d) = LeaseFlow _d b 0 0 +viewTsRow _d (FixedFlow a b c d e f ) = FixedFlow _d b 0 0 0 0 +viewTsRow _d (BondFlow a b c d) = BondFlow _d b 0 0 +viewTsRow _d (ReceivableFlow a b c d e f g h i) = ReceivableFlow _d b 0 0 0 0 0 0 i + +-- ^ given a cashflow,build a new cf row with begin balance +buildBegTsRow :: Date -> TsRow -> TsRow +buildBegTsRow d flow@FixedFlow{} = flow +buildBegTsRow d tr = + let + r = set tsRowBalance ((view tsRowBalance tr) + mflowAmortAmount tr) (emptyTsRow d tr) + rate = mflowRate tr + in + tsSetRate rate r + +buildStartTsRow :: CashFlowFrame -> Maybe TsRow +buildStartTsRow (CashFlowFrame (begBal,begDate,accInt) []) = Nothing +buildStartTsRow (CashFlowFrame (begBal,begDate,accInt) (txn:txns)) = + let + rEmpty = emptyTsRow begDate txn + r = set tsRowBalance begBal rEmpty + rate = mflowRate txn + in + Just $ tsSetRate rate r + +tsSetRate :: IRate -> TsRow -> TsRow +tsSetRate _r (MortgageDelinqFlow a b c d e f g h i j k l m) = MortgageDelinqFlow a b c d e f g h i _r k l m +tsSetRate _r (MortgageFlow a b c d e f g h i j k l) = MortgageFlow a b c d e f g h _r j k l +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" + + +insertBegTsRow :: Date -> CashFlowFrame -> CashFlowFrame +insertBegTsRow d (CashFlowFrame st []) = CashFlowFrame st [] +insertBegTsRow d (CashFlowFrame st (txn:txns)) + = let + begRow = buildBegTsRow d txn + in + CashFlowFrame st (begRow:txn:txns) + + +totalLoss :: CashFlowFrame -> Balance +totalLoss (CashFlowFrame _ rs) = sum $ mflowLoss <$> rs + +totalDefault :: CashFlowFrame -> Balance +totalDefault (CashFlowFrame _ rs) = sum $ mflowDefault <$> rs + +totalRecovery :: CashFlowFrame -> Balance +totalRecovery (CashFlowFrame _ rs) = sum $ mflowRecovery <$> rs + +totalPrincipal :: CashFlowFrame -> Balance +totalPrincipal (CashFlowFrame _ rs) = sum $ mflowPrincipal <$> rs + +-- ^ merge two cashflow frame but no patching beg balance +mergePoolCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame +mergePoolCf cf (CashFlowFrame _ []) = cf +mergePoolCf (CashFlowFrame _ []) cf = cf +-- first day of left is earlier than right one +mergePoolCf cf1@(CashFlowFrame st1 txns1) cf2@(CashFlowFrame st2 txns2) + | startDate1 > startDate2 = mergePoolCf cf2 cf1 + | otherwise + = let + splitDate = firstDate cf2 -- (ls,rs) = splitByDate txns d st + (txn0,txnToMerged) = splitByDate txns1 splitDate EqToRight + txn1 = combineTss [] txnToMerged txns2 -- `debug` ("left"++show cfToBeMerged++">> right"++ show cf2) + in + CashFlowFrame st1 (txn0++txn1) -- `debug` ("Txn1"++show txn1) + where + [startDate1,startDate2] = firstDate <$> [cf1,cf2] + + +-- ^ agg cashflow (but not updating the cumulative stats) +aggTs :: [TsRow] -> [TsRow] -> [TsRow] +-- ^ short circuit +aggTs [] [] = [] +-- ^ return result update the cumulative stats +aggTs rs [] = rs +-- ^ init with the first row +aggTs [] (r:rs) = aggTs [r] rs +aggTs (r:rs) (tr:trs) + | sameDate r tr = aggTs (addTs r tr:rs) trs + | otherwise = aggTs (tr:r:rs) trs + + +patchBalance :: (Balance,Maybe CumulativeStat) -> [TsRow] -> [TsRow] -> [TsRow] +patchBalance (bal,stat) [] [] = [] +patchBalance (bal,mStat) r [] = case mStat of + Just stat -> patchCumulative stat [] $ reverse r + Nothing -> patchCumulative (0,0,0,0,0,0) [] $ reverse r +patchBalance (bal,stat) r (tr:trs) = + let + amortAmt = mflowAmortAmount tr + newBal = bal - amortAmt + rWithUpdatedBal = set tsRowBalance newBal tr + in + patchBalance (newBal,stat) (rWithUpdatedBal:r) trs + +-- type CumulativeStat = (CumPrincipal,CumPrepay,CumDelinq,CumDefault,CumRecovery,CumLoss) +-- +calcBeginStats :: Maybe CumulativeStat -> TsRow -> CumulativeStat +calcBeginStats Nothing tr = (0,0,0,0,0,0) +calcBeginStats (Just (cumPrin,cumPrepay,cumDlinq,cumDef,cumRec,cumLoss)) tr + = case tr of + (MortgageFlow _ _ p _ ppy def rec los _ _ _ _) -> + (cumPrin - p,cumPrepay - ppy, 0 , cumDef - def, cumRec - rec , cumLoss - los) + (MortgageDelinqFlow _ _ p _ ppy delinq def rec los _ _ _ _) -> + (cumPrin - p,cumPrepay - ppy, cumDlinq - delinq , cumDef - def, cumRec - rec , cumLoss - los) + (LoanFlow _ _ p _ ppy def rec los _ _) -> + (cumPrin - p,cumPrepay - ppy, 0 , cumDef - def, cumRec - rec , cumLoss - los) + (ReceivableFlow _ _ _ p f def rec los _) -> + (cumPrin - p, 0 , 0 , cumDef - def, cumRec - rec , cumLoss - los) + (BondFlow _ _ p i) -> + (cumPrin - p,0 , 0 , 0, 0, 0) + (LeaseFlow _ b r def ) -> + (cumPrin - r,0 , 0, cumDef - def, 0, 0) + (FixedFlow _ b c d e _ ) -> (0, 0 ,0 , 0, 0, 0) + (CashFlow _ amt) -> (0,0,0,0,0,0) + + +getCfBegStats :: CashFlowFrame -> CumulativeStat +getCfBegStats (CashFlowFrame _ []) = (0,0,0,0,0,0) +getCfBegStats (CashFlowFrame _ (tr:trs)) = calcBeginStats (view tsCumulative tr) tr + + +mergePoolCf2 :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame +mergePoolCf2 cf (CashFlowFrame _ []) = cf +mergePoolCf2 (CashFlowFrame _ []) cf = cf +mergePoolCf2 cf1@(CashFlowFrame st1@(bBal1,bDate1,a1) txns1) cf2@(CashFlowFrame (bBal2,bDate2,a2) txns2) + | null txns2 = over cashflowTxn (patchBalance (bBal1,head txns1 ^. tsCumulative) []) cf1 + | bDate1 > bDate2 = mergePoolCf2 cf2 cf1 + -- both cashflow frame start on the same day OR left one starts earlier than right one + -- 20241021:why? | bDate1 == bDate2 && bBal2 == 0 = over cashflowTxn (patchBalance bBal1 []) cf1 + | bDate1 == bDate2 && bBal2 == 0 = cf1 + | bDate1 == bDate2 = + let + begBal = bBal1 + bBal2 + + begStat = sumStats (Just (getCfBegStats cf1)) (Just (getCfBegStats cf2)) + txnsSorted = reverse $ L.sortOn getDate (txns1 ++ txns2) + txnAggregated = aggTs [] txnsSorted + txnPatchedBalance = patchBalance (begBal,begStat) [] txnAggregated -- `debug` ("\n Pathcing with stat"++ show begStat) + in + CashFlowFrame (begBal, bDate1, a1) txnPatchedBalance + | otherwise + = let + (resultCf1, cfToCombine) = splitCashFlowFrameByDate cf1 bDate2 EqToRight + (CashFlowFrame _ txnCombined) = mergePoolCf2 cfToCombine cf2 + in + over cashflowTxn (++ txnCombined) resultCf1 + + +mergeCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame +mergeCf cf (CashFlowFrame _ []) = cf +mergeCf (CashFlowFrame _ []) cf = cf +mergeCf cf1@(CashFlowFrame (begBal1,begDate1,mAccInt1) txns1) cf2@(CashFlowFrame (begBal2,begDate2,mAccInt2)txns2) -- first day of left is earlier than right one + = let + mSrow1 = buildStartTsRow cf1 + mSrow2 = buildStartTsRow cf2 + txns1' = case mSrow1 of + Nothing -> txns1 + Just srow1 -> srow1:txns1 + txns2' = case mSrow2 of + Nothing -> txns2 + Just srow2 -> srow2:txns2 + txns = combineTss [] txns1' txns2' + newSt = if begDate1 < begDate2 then (begBal1,begDate1,mAccInt1) else (begBal2,begDate2,mAccInt2) + in + CashFlowFrame newSt txns + + +consolidateCashFlow :: CashFlowFrame -> CashFlowFrame +consolidateCashFlow (CashFlowFrame st []) = CashFlowFrame st [] +consolidateCashFlow (CashFlowFrame st (txn:txns)) + = let + totalBals = sum $ mflowAmortAmount <$> (txn:txns) + in + CashFlowFrame st (set tsRowBalance totalBals txn:txns) + + +shiftCfToStartDate :: Date -> CashFlowFrame -> CashFlowFrame +shiftCfToStartDate d cf@(CashFlowFrame st (txn:txns)) + = let + fstDate = firstDate cf + diffDays = daysBetween fstDate d + in + CashFlowFrame st $ tsOffsetDate diffDays <$> (txn:txns) + +-- ^ sum a single pool source from a cashflow frame +sumPoolFlow :: CashFlowFrame -> PoolSource -> Balance +sumPoolFlow (CashFlowFrame _ trs) ps + = sum $ (`lookupSource` ps) <$> trs + +-- ^ lookup a pool source from a row +lookupSource :: TsRow -> PoolSource -> Balance +lookupSource tr CollectedPrepayment = mflowPrepayment tr +lookupSource tr CollectedPrincipal = mflowPrincipal tr +lookupSource tr CollectedRecoveries = mflowRecovery tr +lookupSource tr CollectedRental = mflowRental tr +lookupSource tr CollectedInterest = mflowInterest tr +lookupSource tr CollectedPrepaymentPenalty = mflowPrepaymentPenalty tr +lookupSource tr CollectedFeePaid = mflowFeePaid tr +lookupSource tr CollectedCash = tsTotalCash tr +lookupSource tr NewDelinquencies = mflowDelinq tr +lookupSource tr NewDefaults = mflowDefault tr +lookupSource tr NewLosses = mflowLoss tr +lookupSource tr CurBalance = view tsRowBalance tr +lookupSource tr CurBegBalance = mflowBegBalance tr +lookupSource tr x = error ("Failed to lookup source"++ show x) + +lookupSourceM :: Balance -> Maybe TsRow -> PoolSource -> Balance +lookupSourceM bal Nothing CurBegBalance = bal +lookupSourceM bal Nothing CurBalance = bal +lookupSourceM _ Nothing _ = 0 +lookupSourceM _ (Just tr) ps = lookupSource tr ps + + +setPrepaymentPenalty :: Balance -> TsRow -> TsRow +setPrepaymentPenalty bal (MortgageDelinqFlow a b c d e f g h i j k l m) = MortgageDelinqFlow a b c d e f g h i j k (Just bal) m +setPrepaymentPenalty bal (MortgageFlow b c d e f g h i j k l m) = MortgageFlow b c d e f g h i j k (Just bal) m +setPrepaymentPenalty _ _ = error "prepay pental only applies to MortgageFlow" + +setPrepaymentPenaltyFlow :: [Balance] -> [TsRow] -> [TsRow] +setPrepaymentPenaltyFlow bals trs = [ setPrepaymentPenalty bal tr | (bal,tr) <- zip bals trs] + + +-- ^ split single cashflow record by a rate +splitTs :: Rate -> TsRow -> TsRow +splitTs r (MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN mStat) + = MortgageDelinqFlow d (mulBR bal r) (mulBR p r) (mulBR i r) (mulBR ppy r) + (mulBR delinq r) (mulBR def r) (mulBR recovery r) (mulBR loss r) + rate ((\x -> round (toRational x * r)) <$> mB) ((`mulBR` r) <$> mPPN) + (splitStats r <$> mStat) +splitTs r (MortgageFlow d bal p i ppy def recovery loss rate mB mPPN mStat) + = MortgageFlow d (mulBR bal r) (mulBR p r) (mulBR i r) (mulBR ppy r) + (mulBR def r) (mulBR recovery r) (mulBR loss r) + rate ((\x -> round (toRational x * r)) <$> mB) ((`mulBR` r) <$> mPPN) + (splitStats r <$> mStat) +splitTs r (LeaseFlow d bal p def) + = LeaseFlow d (mulBR bal r) (mulBR p r) (mulBR def r) +splitTs _ tr = error $ "Not support for spliting TsRow"++show tr + +splitTrs :: Rate -> [TsRow] -> [TsRow] +splitTrs r trs = splitTs r <$> trs + +splitCf :: Rate -> CashFlowFrame -> CashFlowFrame +splitCf 1 cf = cf +splitCf r (CashFlowFrame st []) = CashFlowFrame st [] +splitCf r (CashFlowFrame (begBal, begDate, mAccInt) trs) + = CashFlowFrame (mulBR begBal r, begDate, (`mulBR` r) <$> mAccInt) $ splitTrs r trs -- `debug` ("split by rate"++ show (fromRational r)) + +currentCumulativeStat :: [TsRow] -> CumulativeStat +currentCumulativeStat [] = (0,0,0,0,0,0) +currentCumulativeStat trs = + let + tr = last trs + in + fromMaybe (0,0,0,0,0,0) $ view txnCumulativeStats tr + + +cashFlowInitCumulativeStats :: Lens' CashFlowFrame (Maybe CumulativeStat) +cashFlowInitCumulativeStats = lens getter setter + where + getter (CashFlowFrame _ []) = Nothing + getter (CashFlowFrame _ (tr:trs)) = view txnCumulativeStats tr + + setter (CashFlowFrame st []) mStat = CashFlowFrame st [] + setter (CashFlowFrame st (tr:trs)) mStat = CashFlowFrame st $ (set txnCumulativeStats mStat tr):trs + + +patchCumulativeAtInit :: Maybe CumulativeStat -> [TsRow] -> [TsRow] +patchCumulativeAtInit _ [] = [] +patchCumulativeAtInit mStatsInit (MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN mStat:trs) + = MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN (sumStats mStat mStatsInit):trs +patchCumulativeAtInit mStatsInit (MortgageFlow d bal p i ppy def recovery loss rate mB mPPN mStat:trs) + = MortgageFlow d bal p i ppy def recovery loss rate mB mPPN (sumStats mStat mStatsInit):trs +patchCumulativeAtInit mStatsInit (LoanFlow d bal p i ppy def recovery loss rate mStat:trs) + = LoanFlow d bal p i ppy def recovery loss rate (sumStats mStat mStatsInit):trs +patchCumulativeAtInit mStatsInit (ReceivableFlow d bal p i ppy def recovery loss mStat:trs) + = ReceivableFlow d bal p i ppy def recovery loss (sumStats mStat mStatsInit):trs +patchCumulativeAtInit _ trs = trs + + +patchCumulative :: CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow] +patchCumulative _ rs [] = reverse rs +patchCumulative (cPrin,cPrepay,cDelinq,cDefault,cRecovery,cLoss) + rs + (MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN _:trs) + = patchCumulative newSt + (MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN (Just newSt):rs) + trs + where + newSt = (cPrin+p,cPrepay+ppy,cDelinq+delinq,cDefault+def,cRecovery+recovery,cLoss+loss) +patchCumulative (cPrin,cPrepay,cDelinq,cDefault,cRecovery,cLoss) + rs + ((MortgageFlow d bal p i ppy def recovery loss rate mB mPPN _):trs) + = patchCumulative newSt + (MortgageFlow d bal p i ppy def recovery loss rate mB mPPN (Just newSt):rs) + trs + where + newSt = (cPrin+p,cPrepay+ppy,cDelinq,cDefault+def,cRecovery+recovery,cLoss+loss) +patchCumulative (cPrin,cPrepay,cDelinq,cDefault,cRecovery,cLoss) + rs + ((LoanFlow d bal p i ppy def recovery loss rate _):trs) + = patchCumulative newSt + (LoanFlow d bal p i ppy def recovery loss rate (Just newSt):rs) + trs + where + newSt = (cPrin+p,cPrepay+ppy,cDelinq,cDefault+def,cRecovery+recovery,cLoss+loss) + +patchCumulative (cPrin,cPrepay,cDelinq,cDefault,cRecovery,cLoss) + rs + ((FixedFlow a b c d e f):trs) + = patchCumulative newSt + (FixedFlow a b c d e f:rs) + trs + where + newSt = (0,0,0,0,0,0) + +patchCumulative (cPrin,cPrepay,cDelinq,cDefault,cRecovery,cLoss) + rs + ((ReceivableFlow a b c d e f g h i):trs) + = patchCumulative newSt + (ReceivableFlow a b c d e f g h (Just newSt):rs) + trs + where + newSt = (cPrin+c,0,0,cDefault+f,cRecovery+g,cLoss+h) + +patchCumulative (cPrin,cPrepay,cDelinq,cDefault,cRecovery,cLoss) + rs + ((LeaseFlow a b c d) :trs) + = patchCumulative newSt + (LeaseFlow a b c d:rs) + trs + where + newSt = (0,0,0,0,0,0) + +patchCumulative a b c = error ("failed to patch cumulative stats for "++show a ++">>"++show b++">>"++show c) + + + +-- ^ split cashflow by rate while build missing defaults/losses stats +cutoffTrs :: Date -> [TsRow] -> ([TsRow],Map.Map CutoffFields Balance) +cutoffTrs d [] = ([],Map.empty) +cutoffTrs d trs + = let + beforeTrs = cutBy Exc Past d trs + cumuDefaults = sum $ mflowDefault <$> beforeTrs + cumuDelinquency = sum $ mflowDelinq <$> beforeTrs + cumuLoss = sum $ mflowLoss <$> beforeTrs + m = Map.fromList [(HistoryDefaults,cumuDefaults),(HistoryDelinquency,cumuDelinquency),(HistoryLoss,cumuLoss)] + + afterTrs = cutBy Inc Future 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 +isEmptyRow (LoanFlow _ 0 0 0 0 0 0 0 i j ) = True +isEmptyRow (LeaseFlow _ 0 0 0) = True +isEmptyRow (FixedFlow _ 0 0 0 0 0) = True +isEmptyRow (BondFlow _ 0 0 0) = True +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 +isEmptyRow2 (LoanFlow _ _ 0 0 0 0 0 0 i j ) = True +isEmptyRow2 (LeaseFlow _ _ 0 _) = True +isEmptyRow2 (FixedFlow _ _ 0 0 0 0) = True +isEmptyRow2 (BondFlow _ _ 0 0) = True +isEmptyRow2 (CashFlow _ 0) = True +isEmptyRow2 (ReceivableFlow _ _ 0 0 0 0 0 0 _ ) = True +isEmptyRow2 _ = False + +-- ^ Remove empty cashflow from the tail +dropTailEmptyTxns :: [TsRow] -> [TsRow] +dropTailEmptyTxns trs + = reverse $ dropWhile isEmptyRow (reverse trs) + + +cashflowTxn :: Lens' CashFlowFrame [TsRow] +cashflowTxn = lens getter setter + where + getter (CashFlowFrame _ txns) = txns + setter (CashFlowFrame st txns) newTxns = CashFlowFrame st newTxns + + +txnCumulativeStats :: Lens' TsRow (Maybe CumulativeStat) +txnCumulativeStats = lens getter setter + where + getter (MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN mStat) = mStat + getter (MortgageFlow d bal p i ppy def recovery loss rate mB mPPN mStat) = mStat + getter (LoanFlow d bal p i ppy def recovery loss rate mStat) = mStat + getter (ReceivableFlow d bal p i ppy def recovery loss mStat) = mStat + getter _ = Nothing + + setter (MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN _) mStat + = MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN mStat + setter (MortgageFlow d bal p i ppy def recovery loss rate mB mPPN _) mStat + = MortgageFlow d bal p i ppy def recovery loss rate mB mPPN mStat + setter (LoanFlow d bal p i ppy def recovery loss rate _) mStat + = LoanFlow d bal p i ppy def recovery loss rate mStat + setter (ReceivableFlow d bal p i ppy def recovery loss _) mStat + = ReceivableFlow d bal p i ppy def recovery loss mStat + setter x _ = x + +$(deriveJSON defaultOptions ''TsRow) +$(deriveJSON defaultOptions ''CashFlowFrame) diff --git a/src/CreditEnhancement.hs b/src/CreditEnhancement.hs new file mode 100644 --- /dev/null +++ b/src/CreditEnhancement.hs @@ -0,0 +1,294 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module CreditEnhancement + (LiqFacility(..),LiqSupportType(..),buildLiqResetAction,buildLiqRateResetAction + ,LiquidityProviderName,draw,repay,accrueLiqProvider + ,LiqDrawType(..),LiqRepayType(..),LiqCreditCalc(..) + ,consolStmt,CreditDefaultSwap(..), + ) + where + +import qualified Data.Text as T +import qualified Data.Time as Time +import qualified Data.Map as Map +import qualified Data.DList as DL +import GHC.Generics +import Language.Haskell.TH +import Data.Aeson hiding (json) +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Fixed +import Data.Maybe +import Types +import Util +import DateUtil +import Stmt +import qualified InterestRate as IR + +import qualified Stmt as S + +import Debug.Trace +import Lib (paySeqLiabilities) +import Data.Decimal +debug = flip trace + +type LiquidityProviderName = String + +-- ^ describle credit support +data LiqSupportType = ReplenishSupport DatePattern Balance -- ^ Credit will be refresh by an interval + | FixSupport Balance -- ^ Fixed credit amount + | ByPct DealStats Rate -- ^ By a pct of formula + | UnLimit -- ^ Unlimit credit support, like insurance company + deriving(Show,Generic,Eq,Ord) + + +data LiqDrawType = LiqToAcc -- ^ draw credit and deposit cash to account + | LiqToBondInt -- ^ draw credit and pay to bond interest if any shortfall + | LiqToBondPrin -- ^ draw credit and pay to bond principal if any shortfall + | LiqToFee -- ^ draw credit and pay to a fee if there is a shortfall + deriving (Show,Generic,Ord,Eq) + + +data LiqRepayType = LiqBal -- ^ repay oustanding balance of liquidation provider + | LiqPremium -- ^ repay oustanding premium fee of lp + | LiqInt -- ^ repay oustanding interest of lp + | LiqRepayTypes [LiqRepayType] -- ^ repay by sequence + | LiqResidual + | LiqOD + deriving (Show,Generic,Ord,Eq) + +data LiqCreditCalc = IncludeDueInt + | IncludeDuePremium + | IncludeBoth + deriving (Show,Generic,Ord,Eq) + + +data LiqFacility = LiqFacility { + liqName :: String + ,liqType :: LiqSupportType + ,liqBalance :: Balance -- ^ total balance supported/drawed + ,liqCredit :: Maybe Balance -- ^ available balance to support. Nothing -> unlimit + ,liqCreditCalc :: Maybe LiqCreditCalc -- ^ how to calculate credit + + ,liqRateType :: Maybe IR.RateType -- ^ interest rate type + ,liqPremiumRateType :: Maybe IR.RateType -- ^ premium rate type + + ,liqRate :: Maybe IRate -- ^ current interest rated on oustanding balance + ,liqPremiumRate :: Maybe IRate -- ^ current premium rate used on unused credit, a.k. commitment fee + + ,liqDueIntDate :: Maybe Date -- ^ last day of interest/premium calculated + + ,liqDueInt :: Balance -- ^ oustanding due on interest + ,liqDuePremium :: Balance -- ^ oustanding due on premium + + ,liqStart :: Date -- ^ when liquidiy provider came into effective + ,liqEnds :: Maybe Date -- ^ when liquidiy provider came into expired + ,liqStmt :: Maybe Statement -- ^ transaction history +} deriving (Show,Generic,Eq,Ord) + +consolStmt :: LiqFacility -> LiqFacility +consolStmt liq@LiqFacility{liqStmt = Nothing} = liq +consolStmt liq@LiqFacility{liqStmt = Just (S.Statement txn')} + | DL.empty == txn' = liq + | otherwise = let + (txn:txns) = DL.toList txn' + combinedBondTxns = foldl S.consolTxn [txn] txns + droppedTxns = dropWhile S.isEmptyTxn combinedBondTxns + in + liq {liqStmt = Just (S.Statement (DL.fromList (reverse droppedTxns)))} + + +-- | update the reset events of liquidity provider +buildLiqResetAction :: [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)] +buildLiqResetAction [] ed r = r +buildLiqResetAction (liqProvider:liqProviders) ed r = + case liqProvider of + (LiqFacility lqName (ReplenishSupport dp bal) _ _ _ _ _ _ _ _ _ _ ss _ _) -- update the support credit of liquidity provider + -> buildLiqResetAction + liqProviders + ed + [(lqName, projDatesByPattern dp ss ed)]++r + _ -> buildLiqResetAction liqProviders ed r + + +-- | update the rate reset events of liquidity provider +buildLiqRateResetAction :: [LiqFacility] -> Date -> [(String, Dates)] -> [(String, Dates)] +buildLiqRateResetAction [] ed r = r +buildLiqRateResetAction (liq:liqProviders) ed r = + case liq of + liq@LiqFacility{liqRateType = rt, liqPremiumRateType = prt, liqName = ln , liqStart = sd} -> + buildLiqRateResetAction + liqProviders + ed + [(ln,IR.getRateResetDates sd ed rt ++ IR.getRateResetDates sd ed prt)]++r + _ -> buildLiqRateResetAction liqProviders ed r + + +-- | draw cash from liquidity provider +draw :: Amount -> Date -> LiqFacility -> LiqFacility +draw amt d liq@LiqFacility{ liqBalance = liqBal + ,liqStmt = mStmt + ,liqCredit = mCredit + ,liqDueInt = dueInt + ,liqDuePremium = duePremium} + | isJust mCredit && (fromMaybe 0 mCredit) <= 0 = + liq { liqStmt = appendStmt (SupportTxn d mCredit liqBal dueInt duePremium 0 LiquidationDraw) mStmt } + | otherwise = liq { liqBalance = newBal,liqCredit = newCredit,liqStmt = newStmt} + where + newCredit = (\x -> x - amt) <$> mCredit + newBal = liqBal + amt + newStmt = appendStmt (SupportTxn d newCredit newBal dueInt duePremium (negate amt) LiquidationDraw) mStmt + + +repay :: Amount -> Date -> LiqRepayType -> LiqFacility -> LiqFacility +repay amt d pt liq@LiqFacility{liqBalance = liqBal + ,liqStmt = mStmt + ,liqCredit = mCredit + ,liqCreditCalc = mCreditType + ,liqDueInt = liqDueInt + ,liqDuePremium = liqDuePremium + ,liqType = lt} + = liq {liqBalance = newBal ,liqCredit = newCredit ,liqDueInt = newIntDue + ,liqDuePremium = newDuePremium ,liqStmt = newStmt} + where + (newBal, newIntDue, newDuePremium) = + case pt of + LiqBal -> ( liqBal - amt, liqDueInt, liqDuePremium ) + LiqPremium -> ( liqBal , liqDueInt, liqDuePremium - amt ) + LiqInt -> ( liqBal , max 0 (liqDueInt - amt), liqDuePremium ) + _ -> ( liqBal, liqDueInt, liqDuePremium ) + + newCredit = case (mCreditType,pt) of + (_ , LiqOD) -> (+ amt) <$> mCredit + (Nothing, _) -> mCredit + (Just IncludeDueInt, LiqInt) -> (+ amt) <$> mCredit + (Just IncludeDuePremium, LiqPremium) -> (+ amt) <$> mCredit + (Just IncludeBoth, LiqInt) -> (+ amt) <$> mCredit + (Just IncludeBoth, LiqPremium) -> (+ amt) <$> mCredit + _ -> mCredit + + newStmt = appendStmt (SupportTxn d newCredit newBal newIntDue newDuePremium amt (LiquidationRepay (show pt))) mStmt + +-- | accure fee and interest of a liquidity provider and update credit available +accrueLiqProvider :: Date -> LiqFacility -> LiqFacility +accrueLiqProvider d liq@(LiqFacility _ _ curBal mCredit _ mRateType mPRateType rate prate dueDate dueInt duePremium sd mEd Nothing) + = accrueLiqProvider d $ liq{liqStmt = Just defaultStmt} + where + -- insert begining record + defaultStmt = Statement $ DL.singleton $ SupportTxn sd mCredit curBal dueInt duePremium 0 Empty + +accrueLiqProvider d liq@(LiqFacility _ _ curBal mCredit mCreditType mRateType mPRateType rate prate dueDate dueInt duePremium sd mEd mStmt@(Just (Statement txns))) + = liq { liqStmt = newStmt + ,liqDueInt = newDueInt + ,liqDuePremium = newDueFee + ,liqCredit = newCredit + ,liqDueIntDate = Just d + } + where + lastAccDate = fromMaybe sd dueDate + accureInt = case rate of + Nothing -> 0 + Just r -> + let + bals = weightAvgBalanceByDates [lastAccDate,d] (DL.toList txns) + in + sum $ flip mulBIR r <$> bals -- `debug` ("Accure Using Rate"++show r++"avg bal"++ show bals ++"ds"++show [lastAccDate,d]) + accureFee = case prate of + Nothing -> 0 + Just r -> + let + (_,_unAccTxns) = splitByDate (DL.toList txns) lastAccDate EqToLeftKeepOne + accBals = getUnusedBal <$> _unAccTxns + _ds = lastAccDate : tail (getDate <$> _unAccTxns) + _avgBal = calcWeightBalanceByDates DC_ACT_365F accBals (_ds++[d]) + in + mulBIR _avgBal r + + getUnusedBal (SupportTxn _ b _ _ _ _ _) = fromMaybe 0 b + + newDueFee = accureFee + duePremium + newDueInt = accureInt + dueInt + newCredit = case mCreditType of + Nothing -> mCredit + Just IncludeDueInt -> (\x -> x - accureInt) <$> mCredit + Just IncludeDuePremium -> (\x -> x - accureFee) <$> mCredit + Just IncludeBoth -> (\x -> x - accureInt - accureFee) <$> mCredit + + newStmt = appendStmt (SupportTxn d newCredit curBal newDueInt newDueFee 0 (LiquidationSupportInt accureInt accureFee)) mStmt + + +instance QueryByComment LiqFacility where + queryStmt liq@LiqFacility{liqStmt = Nothing} tc = [] + queryStmt liq@LiqFacility{liqStmt = (Just (Statement txns))} tc + = filter (\x -> getTxnComment x == tc) (DL.toList txns) + + +instance Liable LiqFacility where + isPaidOff liq@LiqFacility{liqBalance=bal,liqDueInt=dueInt,liqDuePremium=duePremium} + | bal==0 && dueInt==0 && duePremium==0 = True + | otherwise = False + + getCurBalance LiqFacility{liqBalance = bal} = bal + + getDueInt LiqFacility{liqDueInt = dueInt} = dueInt + + getOutstandingAmount LiqFacility{liqBalance = bal,liqDueInt = dueInt,liqDuePremium = duePremium} = bal + dueInt + duePremium + + getOriginBalance LiqFacility{liqBalance = bal} = 0 + +instance IR.UseRate LiqFacility where + getIndexes liq@LiqFacility{liqRateType = mRt,liqPremiumRateType = mPrt} + = case (mRt,mPrt) of + (Nothing, Nothing) -> Nothing + (Just (IR.Floater _ idx _ _ _ _ _ _), Nothing ) -> Just [idx] + (Nothing, Just (IR.Floater _ idx _ _ _ _ _ _)) -> Just [idx] + (Just (IR.Floater _ idx1 _ _ _ _ _ _), Just (IR.Floater _ idx2 _ _ _ _ _ _)) -> Just [idx1,idx2] + _ -> Nothing + + isAdjustbleRate liq@LiqFacility{liqRateType = mRt,liqPremiumRateType = mPrt} + = case (mRt,mPrt) of + (Just (IR.Floater {}), _ ) -> True + (_, Just (IR.Floater {})) -> True + _ -> False + + getIndex liq = head <$> IR.getIndexes liq + +data CreditDefaultSwap = CDS { + cdsName :: String + ,cdsAccrue :: Maybe DatePattern + + ,cdsCoverage :: DealStats -- ^ the coverage + ,cdsDue :: Balance -- ^ the amount to collect from CDS,paid to SPV as cure to loss incurred by SPV + ,cdsLast :: Maybe Date -- ^ last date of Due calc + + ,cdsPremiumRefBalance :: DealStats -- ^ how notional balance is calculated + ,cdsPremiumRate :: IRate -- ^ the rate to calculate premium + ,cdsRateType :: IR.RateType -- ^ interest rate type + + ,cdsPremiumDue :: Balance -- ^ the due premium to payout from SPV + ,cdsLastCalcDate :: Maybe Date -- ^ last calculate date on net cash + + ,cdsSettle :: Maybe DatePattern + ,cdsSettleDate :: Maybe Date -- ^ last setttle date on net cash + ,cdsNetCash :: Balance -- ^ the net cash to settle ,negative means SPV pay to CDS, positive means CDS pay to SPV + + ,cdsStart :: Date + ,cdsEnds :: Maybe Date + ,cdsStmt :: Maybe Statement +} deriving (Show, Generic, Eq, Ord) + +instance IR.UseRate CreditDefaultSwap where + getIndexes cds@CDS{cdsRateType = rt} + = case rt of + (IR.Floater _ idx _ _ _ _ _ _) -> Just [idx] + (IR.Fix _ _) -> Nothing + + +$(deriveJSON defaultOptions ''LiqRepayType) +$(deriveJSON defaultOptions ''LiqDrawType) +$(deriveJSON defaultOptions ''LiqSupportType) +$(deriveJSON defaultOptions ''LiqCreditCalc) +$(deriveJSON defaultOptions ''LiqFacility) diff --git a/src/DateUtil.hs b/src/DateUtil.hs new file mode 100644 --- /dev/null +++ b/src/DateUtil.hs @@ -0,0 +1,343 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DateUtil( + yearCountFraction,genSerialDates,genSerialDatesTill,genSerialDatesTill2,subDates,sliceDates,SliceType(..) + ,splitByDate,projDatesByPattern,monthsAfter,getIntervalFactorsDc + ,daysInterval +) + + where + +import qualified Data.Time as T +import Data.List +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Ratio ((%)) +import Debug.Trace +import Data.Time (addDays) +import Types +import Data.Ix +import Lib + +import Control.Exception + +debug = flip trace + +-- http://www.deltaquants.com/day-count-conventions +-- https://www.iso20022.org/15022/uhb/mt565-16-field-22f.htm +yearCountFraction :: DayCount -> Date -> Date -> Rational +yearCountFraction dc sd ed + = case dc of + DC_ACT_ACT -> if sameYear then + _diffDays % daysOfYear syear + else + (sDaysTillYearEnd % (daysOfYear syear)) + (eDaysAfterYearBeg % (daysOfYear eyear)) + (pred _diffYears) + -- `debug` ("<>"++show sDaysTillYearEnd++"<>"++show(daysOfYear syear) ++"<>"++show (daysOfYear eyear)++"<>"++ show eyear) + + DC_ACT_365F -> _diffDays % 365 + + DC_ACT_360 -> _diffDays % 360 + + DC_ACT_365A -> if has_leap_day then + _diffDays % 366 + else + _diffDays % 365 + + DC_ACT_365L -> if T.isLeapYear eyear then + _diffDays % 366 + else + _diffDays % 365 + + DC_NL_365 -> if has_leap_day then + (pred _diffDays) % 365 + else + _diffDays % 365 + + DC_30E_360 -> let + _sday = f31to30 sday + _eday = f31to30 eday + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears + in + num / 360 -- `debug` ("NUM->"++show num++"E S month"++show emonth++show smonth) + + DC_30Ep_360 -> let + _sday = f31to30 sday + (_eyear,_emonth,_eday) = T.toGregorian $ + if eday==31 then + T.addDays 1 ed + else + ed + __gapMonth = (toInteger $ _emonth - smonth) % 1 + __diffYears = (toInteger $ _eyear - syear) % 1 + num = toRational (_eday - _sday) + 30*__gapMonth + 360*__diffYears + in + num / 360 + DC_30_360_ISDA -> let + _sday = f31to30 sday + _eday = if _sday>=30 && eday==31 then + 30 + else + eday + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears + in + num / 360 + -- 30/360 Bond basis , this was call 30E/360 ISDA by kalotay + DC_30_360_German -> let + _sday = if sday==31 || (endOfFeb syear smonth sday) then + 30 -- `debug` ("German eof start if>> "++ show (endOfFeb syear smonth sday)++show syear ++show smonth++show sday) + else + sday + -- `debug` ("German eof start else "++ show (endOfFeb syear smonth sday)++show syear ++show smonth++show sday) + _eday = if eday==31 || (endOfFeb eyear emonth eday) then + 30 + else + eday + -- `debug` ("German eof end "++ show (endOfFeb eyear emonth eday)++show eyear++show emonth++show eday) + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears -- `debug` ("German"++show(_sday)++"<>"++show _eday) + in + num / 360 + DC_30_360_US -> let + _sday = if (endOfFeb syear smonth sday) || sday==31 then + 30 + else + sday + _eday = if (eday==31 && sday >= 30)||(endOfFeb eyear emonth eday) && (endOfFeb syear smonth sday) then + 30 + else + eday + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears + in + num / 360 + _ -> error $ "DayCount not supported" ++ show dc + -- https://www.iso20022.org/15022/uhb/mt565-16-field-22f.htm + + where + daysOfYear y = if T.isLeapYear y then 366 else 365 + f31to30 d = if d==31 then + 30 + else + d + endOfFeb y m d = if T.isLeapYear y then + (m==2) && d == 29 + else + (m==2) && d == 28 + sameYear = syear == eyear + has_leap_day + = case (sameYear,sLeap,eLeap) of + (True,False,False) -> False + (True,True,_) -> inRange (sd,ed) (T.fromGregorian syear 2 29) + _ -> let + _leapDays = [ T.fromGregorian _y 2 29 | _y <- range (syear,eyear) , T.isLeapYear _y ] + in + any (inRange (sd,ed)) _leapDays + + _diffYears = (eyear - syear) % 1 -- Ratio Integer + _gapDay = toInteger (eday - sday) % 1 + _gapMonth = toInteger (emonth - smonth) % 1 + sDaysTillYearEnd = succ $ T.diffDays (T.fromGregorian syear 12 31) sd + eDaysAfterYearBeg = T.diffDays ed (T.fromGregorian eyear 1 1) + _diffDays = toInteger $ T.diffDays ed sd + sLeap = T.isLeapYear syear + eLeap = T.isLeapYear eyear + (syear,smonth,sday) = T.toGregorian sd + (eyear,emonth,eday) = T.toGregorian ed + +genSerialDates :: DatePattern -> CutoffType -> Date -> Int -> Dates +genSerialDates dp ct sd num + = take num $ + filter ftFn $ + case dp of + MonthEnd -> + [T.fromGregorian yearRange (fst __md) (snd __md) | yearRange <- [_y..(_y+yrs)] + ,__md <- monthEnds yearRange ] + where + yrs = fromIntegral $ div num 12 + 1 + QuarterEnd -> + [T.fromGregorian yearRange __m __d | yearRange <- [_y..(_y+yrs)] + ,(__m,__d) <- quarterEnds] + where + yrs = fromIntegral $ div num 4 + 1 + YearEnd -> + [T.fromGregorian yearRange 12 31 | yearRange <- [_y..(_y+(toInteger num))]] + YearFirst -> + [T.fromGregorian yearRange 1 1 | yearRange <- [_y..(_y+(toInteger num))]] + MonthFirst -> + [T.fromGregorian yearRange monthRange 1 | yearRange <- [_y..(_y+yrs)] + , monthRange <- [1..12]] + where + yrs = fromIntegral $ div num 12 + 1 + QuarterFirst -> + [T.fromGregorian yearRange __m 1 | yearRange <- [_y..(_y+yrs)] + ,__m <- [3,6,9,12]] + where + yrs = fromIntegral $ div num 4 + 1 + MonthDayOfYear m d -> + [T.fromGregorian yearRange m d | yearRange <- [_y..(_y+(toInteger num))]] + DayOfMonth d -> + [T.fromGregorian yearRange monthRange d | yearRange <- [_y..(_y+yrs)] + , monthRange <- [1..12]] + where + yrs = fromIntegral $ div num 12 + 1 + Weekday wday -> + [T.addDays (toInteger _n * 7) startDay | _n <- [0..]] + where + dOfWeek = toEnum wday::T.DayOfWeek + startDay = T.firstDayOfWeekOnAfter dOfWeek sd + + CustomDate ds -> ds + EveryNMonth d n -> + d:[ T.addGregorianDurationClip (T.CalendarDiffDays ((toInteger _n)*(toInteger n)) 0) d | _n <- [1..num] ] + SingletonDate d -> [d] + + where + quarterEnds = [(3,31),(6,30),(9,30),(12,31)] + monthEnds y = + if T.isLeapYear y then + [(1,31),(2,29),(3,31),(4,30),(5,31),(6,30),(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)] + else + [(1,31),(2,28),(3,31),(4,30),(5,31),(6,30),(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)] + (_y,_m,_d) = T.toGregorian sd + ftFn = if ct == Inc then + (>= sd) + else + (> sd) + +genSerialDatesTill:: Date -> DatePattern -> Date -> Dates +genSerialDatesTill sd ptn ed + = filter (<= ed) $ genSerialDates ptn Inc sd (fromInteger (succ num)) --`debug` ("Num"++show num) + where + (sy,sm,sday) = T.toGregorian sd + (ey,em,eday) = T.toGregorian ed + T.CalendarDiffDays cdM cdD = T.diffGregorianDurationRollOver ed sd + num = case ptn of + MonthEnd -> cdM + QuarterEnd -> div cdM 3 + YearEnd -> div cdM 12 + MonthFirst -> cdM + QuarterFirst-> div cdM 3 + YearFirst-> div cdM 12 + MonthDayOfYear _m _d -> div cdM 12 -- T.MonthOfYear T.DayOfMonth + DayOfMonth _d -> cdM -- T.DayOfMonth + CustomDate ds -> 2 + toInteger (length ds) + EveryNMonth _d _n -> div cdM (toInteger _n) + Weekday _d -> cdM * 4 + SingletonDate _d -> if _d <= ed then 1 else 0 + _ -> error $ "failed to match" ++ show ptn + -- DayOfWeek Int -> -- T.DayOfWeek + +genSerialDatesTill2 :: RangeType -> Date -> DatePattern -> Date -> Dates +genSerialDatesTill2 rt sd dp ed + = case (rt, head _r==sd, last _r==ed) of + (II,True,True) -> _r + (II,True,False) -> _r ++ [ed] + (II,False,True)-> sd:_r + (II,False,False)-> sd:_r ++ [ed] + (EI,True,True) -> tail _r + (EI,True,False) -> tail _r ++ [ed] + (EI,False,True) -> _r + (EI,False,False) -> _r ++ [ed] + (IE,True,True) -> init _r + (IE,True,False) -> _r + (IE,False,True) -> sd:init _r + (IE,False,False) -> sd:_r + (EE,True,True) -> init $ tail _r + (EE,True,False) -> tail _r + (EE,False,True) -> init _r + (EE,False,False) -> _r + (NO_IE,_,_) -> _r + where + _r = case dp of + -- YearFirst -> throw $ userError "YearFirst not supported in genSerialDatesTill2" + AllDatePattern dps -> concat [ genSerialDatesTill sd _dp ed | _dp <- dps ] + StartsExclusive d _dp -> filter (> d) $ genSerialDatesTill2 rt sd _dp ed + + StartsAt Exc d _dp -> filter (> d) $ genSerialDatesTill2 rt sd _dp ed + StartsAt Inc d _dp -> filter (>= d) $ genSerialDatesTill2 rt sd _dp ed + EndsAt Exc d _dp -> filter (< d) $ genSerialDatesTill2 rt sd _dp ed + EndsAt Inc d _dp -> filter (<= d) $ genSerialDatesTill2 rt sd _dp ed + + Exclude _d _dps -> + let + a = S.fromList $ genSerialDatesTill2 rt sd _d ed + b = S.fromList $ genSerialDatesTill2 rt sd (AllDatePattern _dps) ed + in + sort $ S.toList $ S.difference a b + OffsetBy _dp _n -> [ T.addDays (toInteger _n) _d | _d <- genSerialDatesTill2 rt sd _dp ed ] + _ -> genSerialDatesTill sd dp ed -- maybe sd/ed in _r + + +subDates :: RangeType -> Date -> Date -> [Date] -> [Date] +subDates rt sd ed ds + = case rt of + II -> filter (\x -> x >= sd && x <= ed ) ds + EI -> filter (\x -> x > sd && x <= ed ) ds + IE -> filter (\x -> x >= sd && x < ed ) ds + EE -> filter (\x -> x > sd && x < ed ) ds + NO_IE -> error "Need to specify II/EI/EE/IE when subset dates vector " + +data SliceType = SliceAfter Date + | SliceOnAfter Date + | SliceAfterKeepPrevious Date + | SliceOnAfterKeepPrevious Date + +sliceDates :: SliceType -> [Date] -> [Date] +sliceDates st ds = + case st of + SliceAfter d -> filter (> d) ds + SliceOnAfter d -> filter (>= d) ds + SliceAfterKeepPrevious d -> + case findIndex (> d) ds of + Just idx -> snd $ splitAt (pred idx) ds + Nothing -> [] + SliceOnAfterKeepPrevious d -> + case findIndex (>= d) ds of + Just idx -> snd $ splitAt (pred idx) ds + Nothing -> [] + + +projDatesByPattern :: DatePattern -> Date -> Date -> Dates --TODO to be replace by generateDateSeries +projDatesByPattern dp sd ed + = let + (T.CalendarDiffDays cdm cdd) = T.diffGregorianDurationClip ed sd + num = case dp of + MonthEnd -> cdm + 1 + QuarterEnd -> div cdm 3 + 1 -- `debug` ("cdm"++show cdm) + YearEnd -> div cdm 12 + 1 + MonthFirst -> cdm + 1 + QuarterFirst -> div cdm 3 + 1 + YearFirst -> div cdm 12 + 1 + MonthDayOfYear _ _ -> div cdm 12 + 1 + DayOfMonth _ -> cdm + 1 + in + genSerialDates dp Inc sd (fromInteger num) + +splitByDate :: TimeSeries a => [a] -> Date -> SplitType -> ([a],[a]) +splitByDate xs d st + = case st of + EqToLeft -> span (\x -> getDate x <= d) xs + EqToRight -> span (\x -> getDate x < d) xs + EqToLeftKeepOne -> + case findIndex (\x -> getDate x >= d ) xs of + Just idx -> splitAt (pred idx) xs -- `debug` ("split with "++show (pred idx)++">>"++show (length xs)) + Nothing -> (xs,[]) + -- EqToRightKeepOne -> + -- case findIndex (\x -> (getDate x) >= d ) xs of + -- Just idx -> splitAt (pred idx) xs -- `debug` ("split with "++show (pred idx)++">>"++show (length xs)) + -- Nothing -> (xs,[]) + + -- EqToLeftKeepOnes -> + -- case findIndices (\x -> (getDate x) <= d) xs of + -- [] -> (xs,[]) + -- inds -> + +monthsAfter :: Date -> Integer -> Date +monthsAfter d n = T.addGregorianDurationClip (T.CalendarDiffDays n 0) d + +getIntervalFactorsDc :: DayCount -> [Date] -> [Rate] +getIntervalFactorsDc dc ds + = zipWith (yearCountFraction dc) (init ds) (tail ds) + +daysInterval :: [Date] -> [Integer] +daysInterval ds = zipWith daysBetween (init ds) (tail ds) diff --git a/src/Deal.hs b/src/Deal.hs new file mode 100644 --- /dev/null +++ b/src/Deal.hs @@ -0,0 +1,1603 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleContexts #-} + +module Deal (run,runPool,getInits,runDeal,ExpectReturn(..) + ,performAction + ,populateDealDates,accrueRC + ,calcTargetAmount,updateLiqProvider + ,projAssetUnion,priceAssetUnion + ,removePoolCf,runPoolType,PoolType + ,ActionOnDate(..),DateDesp(..) + ,changeDealStatus + ) where + +import Control.Parallel.Strategies +import qualified Accounts as A +import qualified Ledger as LD +import qualified Asset as Ast +import qualified Pool as P +import qualified Expense as F +import qualified Liability as L +import qualified CreditEnhancement as CE +import qualified Analytics +import qualified Waterfall as W +import qualified Cashflow as CF +import qualified Assumptions as AP +import qualified Reports as Rpt +import qualified AssetClass.AssetBase as ACM +import AssetClass.Mortgage +import AssetClass.Lease +import AssetClass.Loan +import AssetClass.Installment +import AssetClass.MixedAsset + +import qualified Call as C +import qualified InterestRate as IR +import Deal.DealBase +import Deal.DealQuery +import Deal.DealAction +import qualified Deal.DealValidation as V +import Stmt +import Lib +import Util +import DateUtil +import Types +import Revolving +import Triggers + +import qualified Data.Map as Map hiding (mapEither) +import qualified Data.Time as T +import qualified Data.Set as S +import qualified Control.Lens as LS +import Data.List +import qualified Data.DList as DL +import Data.Fixed +import Data.Time.Clock +import Data.Maybe +import Data.Either +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 +import GHC.Generics +import Control.Monad +import Control.Monad.Writer +import Control.Monad.Loops (allM,anyM) +import Control.Applicative (liftA2) + +import Debug.Trace +import Cashflow (buildBegTsRow) +import Assumptions (NonPerfAssumption(NonPerfAssumption),lookupRate0) +import Asset () +import Pool (issuanceStat) +import qualified Types as P +import Control.Lens hiding (element) +import Control.Lens.TH +import Data.Either.Utils +import InterestRate (calcInt) +import Liability (getDayCountFromInfo,getTxnRate) +import Hedge (RateCap(..),RateSwapBase(..),RateSwap(rsRefBalance)) +import qualified Hedge as HE + +debug = flip trace + +-- ^ update bond interest rate from rate assumption +setBondNewRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond +setBondNewRate t d ras b@(L.Bond _ _ L.OriginalInfo{ L.originDate = od} ii _ bal currentRate _ dueInt _ Nothing _ _ _) + = setBondNewRate t d ras b {L.bndDueIntDate = Just od} + +-- ^ Floater rate +setBondNewRate t d ras b@(L.Bond _ _ _ ii@(L.Floater br idx _spd rset dc mf mc) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = Right $ (L.accrueInt d b){ L.bndRate = applyFloatRate ii d ras } + +-- ^ Fix rate, do nothing +setBondNewRate t d ras b@(L.Bond _ _ _ L.Fix {} _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = Right b + +-- ^ Ref rate +setBondNewRate t d ras b@(L.Bond _ _ _ (L.RefRate sr ds factor _) _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = do + let b' = L.accrueInt d b + rate <- queryCompound t d (patchDateToStats d ds) + return b' {L.bndRate = fromRational (rate * toRational factor) } + +-- ^ cap & floor & IoI +setBondNewRate t d ras b@(L.Bond _ _ _ ii _ bal currentRate _ dueInt _ (Just dueIntDate) _ _ _) + = Right $ (L.accrueInt d b) { L.bndRate = applyFloatRate ii d ras} + +-- ^ bond group +setBondNewRate t d ras bg@(L.BondGroup bMap pt) + = do + m <- mapM (setBondNewRate t d ras) bMap + return $ L.BondGroup m pt + +-- ^ apply all rates for multi-int bond +setBondNewRate t d ras b@(L.MultiIntBond bn _ _ iis _ bal currentRates _ dueInts dueIoIs _ _ _ _) + = let + newRates = applyFloatRate <$> iis <*> pure d <*> pure ras + b' = L.accrueInt d b -- `debug` ("accrue due to new rate "++ bn) + in + Right $ b' { L.bndRates = newRates } + + + +setBondStepUpRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond +setBondStepUpRate t d ras b@(L.Bond _ _ _ ii (Just sp) _ _ _ _ _ _ _ _ _) + = Right $ + let + newII = L.stepUpInterestInfo sp ii + newRate = applyFloatRate ii d ras + in + (L.accrueInt d b) { L.bndInterestInfo = newII, L.bndRate = newRate } + +setBondStepUpRate t d ras b@(L.MultiIntBond bn _ _ iis (Just sps) _ _ _ _ _ _ _ _ _) + = Right $ + let + newIIs = zipWith L.stepUpInterestInfo sps iis + newRates = (\x -> applyFloatRate x d ras) <$> newIIs + in + (L.accrueInt d b) { L.bndInterestInfos = newIIs, L.bndRates = newRates } -- `debug` (show d ++ ">> accure due to step up rate "++ bn) + +setBondStepUpRate t d ras bg@(L.BondGroup bMap pt) + = do + m <- mapM (setBondStepUpRate t d ras) bMap + return $ L.BondGroup m pt + + + +updateSrtRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> HE.SRT -> Either String HE.SRT +updateSrtRate t d ras srt@HE.SRT{HE.srtPremiumType = rt} + = do + r <- applyFloatRate2 rt d ras + return srt { HE.srtPremiumRate = r } + + +accrueSrt :: Ast.Asset a => TestDeal a -> Date -> HE.SRT -> Either String HE.SRT +accrueSrt t d srt@HE.SRT{ HE.srtDuePremium = duePrem, HE.srtRefBalance = bal, HE.srtPremiumRate = rate + , HE.srtDuePremiumDate = mDueDate, HE.srtType = st + , HE.srtStart = sd } + = do + newBal <- case st of + HE.SrtByEndDay ds dp -> queryCompound t d (patchDateToStats d ds) + 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} + + +updateLiqProviderRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> CE.LiqFacility -> CE.LiqFacility +updateLiqProviderRate t d ras liq@CE.LiqFacility{CE.liqRateType = mRt, CE.liqPremiumRateType = mPrt + , CE.liqRate = mr, CE.liqPremiumRate = mPr } + = let + newMr = evalFloaterRate d ras <$> mRt + newMpr = evalFloaterRate d ras <$> mPrt + -- TODO probably need to accure int when interest rate changes ? + in + liq {CE.liqRate = newMr, CE.liqPremiumRate = newMpr } + + +evalFloaterRate :: Date -> [RateAssumption] -> IR.RateType -> IRate +evalFloaterRate _ _ (IR.Fix _ r) = r +evalFloaterRate d ras (IR.Floater _ idx spd _r _ mFloor mCap mRounding) + = let + ra = AP.getRateAssumption ras idx + flooring (Just f) v = max f v + flooring Nothing v = v + capping (Just f) v = min f v + capping Nothing v = v + in + case ra of + Nothing -> error "Failed to find index rate in assumption" + Just (RateFlat _ v) -> capping mCap $ flooring mFloor $ v + spd + Just (RateCurve _ curve) -> capping mCap $ flooring mFloor $ fromRational $ getValByDate curve Inc d + toRational spd + +applyFloatRate :: L.InterestInfo -> Date -> [RateAssumption] -> IRate +applyFloatRate (L.Floater _ idx spd p dc mf mc) d ras + = case (mf,mc) of + (Nothing,Nothing) -> _rate + (Just f,Nothing) -> max f _rate + (Just f,Just c) -> min c $ max f _rate + (Nothing,Just c) -> min c _rate + where + idx_rate = case ra of + Just (RateCurve _idx _ts) -> fromRational $ getValByDate _ts Exc d + Just (RateFlat _idx _r) -> _r + Nothing -> 0.0 + ra = AP.getRateAssumption ras idx + _rate = idx_rate + spd -- `debug` ("idx"++show idx_rate++"spd"++show spd) + +applyFloatRate (L.CapRate ii _rate) d ras = min _rate (applyFloatRate ii d ras) +applyFloatRate (L.FloorRate ii _rate) d ras = max _rate (applyFloatRate ii d ras) +applyFloatRate (L.Fix r _ ) d ras = r +applyFloatRate (L.WithIoI ii _) d ras = applyFloatRate ii d ras + +applyFloatRate2 :: IR.RateType -> Date -> [RateAssumption] -> Either String IRate +applyFloatRate2 (IR.Fix _ r) _ _ = Right r +applyFloatRate2 (IR.Floater _ idx spd _r _ mFloor mCap mRounding) d ras + = let + flooring (Just f) v = max f v + flooring Nothing v = v + capping (Just f) v = min f v + capping Nothing v = v + in + do + rateAtDate <- AP.lookupRate0 ras idx d + return $ flooring mFloor $ capping mCap $ rateAtDate + spd + +updateRateSwapRate :: Ast.Asset a => TestDeal a -> Maybe [RateAssumption] -> Date -> HE.RateSwap -> Either String HE.RateSwap +updateRateSwapRate t Nothing _ _ = Left "Failed to update rate swap: No rate input assumption" +updateRateSwapRate t (Just rAssumps) d rs@HE.RateSwap{ HE.rsType = rt } + = let + getRate x = AP.lookupRate rAssumps x d + in + do + (pRate,rRate) <- case rt of + HE.FloatingToFloating flter1 flter2 -> + do + r1 <- getRate flter1 + r2 <- getRate flter2 + return (r1, r2) + HE.FloatingToFixed flter r -> + do + _r <- getRate flter + return (_r, r) + HE.FixedToFloating r flter -> + do + _r <- getRate flter + return (r, _r) + HE.FormulaToFloating ds flter -> + do + _r <- queryCompound t d (patchDateToStats d ds) + r <- getRate flter + return (fromRational _r, r) + HE.FloatingToFormula flter ds -> + do + r <- getRate flter + _r <- queryCompound t d (patchDateToStats d ds) + return (r, fromRational _r) + return rs {HE.rsPayingRate = pRate, HE.rsReceivingRate = rRate } + +updateRateSwapBal :: Ast.Asset a => TestDeal a -> Date -> HE.RateSwap -> Either String HE.RateSwap +updateRateSwapBal t d rs@HE.RateSwap{ HE.rsNotional = base } + = case base of + HE.Fixed _ -> Right rs + HE.Schedule ts -> Right $ rs { HE.rsRefBalance = fromRational (getValByDate ts Inc d) } + HE.Base ds -> + do + v <- queryCompound t d (patchDateToStats d ds) + return rs { HE.rsRefBalance = fromRational v} -- `debug` ("query Result"++ show (patchDateToStats d ds) ) + +-- ^ accure rate cap +accrueRC :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> RateCap -> Either String RateCap +accrueRC t d rs rc@RateCap{rcNetCash = amt, rcStrikeRate = strike,rcIndex = index + ,rcStartDate = sd, rcEndDate = ed, rcNotional = notional + ,rcLastStlDate = mlsd + ,rcStmt = mstmt} + | d > ed || d < sd = Right rc + | otherwise = do + r <- lookupRate0 rs index d + balance <- case notional of + Fixed bal -> Right . toRational $ bal + Base ds -> queryCompound t d (patchDateToStats d ds) + Schedule ts -> Right $ getValByDate ts Inc d + + let accRate = max 0 $ r - fromRational (getValByDate strike Inc d) -- `debug` ("Rate from curve"++show (getValByDate strike Inc d)) + let addAmt = case mlsd of + Nothing -> calcInt (fromRational balance) sd d accRate DC_ACT_365F + Just lstD -> calcInt (fromRational balance) lstD d accRate DC_ACT_365F + + let newAmt = amt + addAmt -- `debug` ("Accrue AMT"++ show addAmt) + let newStmt = appendStmt (IrsTxn d newAmt addAmt 0 0 0 SwapAccrue) mstmt + return $ rc { rcLastStlDate = Just d ,rcNetCash = newAmt, rcStmt = newStmt } + +-- ^ test if a clean up call should be fired +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.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 + C.AfterDate x -> Right $ d > x + C.And xs -> allM (testCall t d) xs + C.Or xs -> anyM (testCall t d) xs + -- C.And xs -> (all id) <$> sequenceA $ [testCall t d x | x <- xs] + -- C.Or xs -> (any id) <$> sequenceA $ [testCall t d x | x <- xs] + C.Pre pre -> testPre d t pre + _ -> Left ("failed to find call options"++ show opt) + + +queryTrigger :: Ast.Asset a => TestDeal a -> DealCycle -> [Trigger] +queryTrigger t@TestDeal{ triggers = trgs } wt + = case trgs of + Nothing -> [] + Just _trgs -> maybe [] Map.elems $ Map.lookup wt _trgs + +-- ^ execute effects of trigger: making changes to deal +-- TODO seems position of arugments can be changed : f :: a -> b -> m a => f:: b -> a -> m a +runEffects :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent) -> Date -> TriggerEffect + -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent) +runEffects (t@TestDeal{accounts = accMap, fees = feeMap ,status=st, bonds = bondMap, pool=pt + ,collects = collRules}, rc, actions, logs) d te + = case te of + DealStatusTo _ds -> Right (t {status = _ds}, rc, actions, logs) + DoAccrueFee fns -> do + newFeeList <- sequenceA $ calcDueFee t d <$> (feeMap Map.!) <$> fns + let newFeeMap = Map.fromList (zip fns newFeeList) <> feeMap + return (t {fees = newFeeMap}, rc, actions, logs) + ChangeReserveBalance accName rAmt -> + Right (t {accounts = Map.adjust (set A.accTypeLens (Just rAmt)) accName accMap } + , rc, actions, logs) + + TriggerEffects efs -> foldM (`runEffects` d) (t, rc, actions, logs) efs + + RunActions wActions -> do + (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 + +-- ^ test triggers in the deal and add a log if deal status changed +runTriggers :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate]) -> Date -> DealCycle -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent) +runTriggers (t@TestDeal{status=oldStatus, triggers = Nothing},rc, actions) d dcycle = Right (t, rc, actions, DL.empty) +runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc, actions) d dcycle = + do + let trgsMap = Map.findWithDefault Map.empty dcycle trgM + let trgsToTest = Map.filter + (\trg -> (not (trgStatus trg) || trgStatus trg && trgCurable trg)) + trgsMap + triggeredTrgs <- mapM (testTrigger t d) trgsToTest + let triggeredEffects = [ trgEffects _trg | _trg <- Map.elems triggeredTrgs, (trgStatus _trg) ] + (newDeal, newRc, newActions, logsFromTrigger) <- foldM (`runEffects` d) (t,rc,actions, DL.empty) triggeredEffects + let newStatus = status newDeal + let newLogs = DL.fromList [DealStatusChangeTo d oldStatus newStatus "By trigger"| newStatus /= oldStatus] -- `debug` (">>"++show d++"trigger : new st"++ show newStatus++"old st"++show oldStatus) + let newTriggers = Map.union triggeredTrgs trgsMap + return (newDeal {triggers = Just (Map.insert dcycle newTriggers trgM)} + , newRc + , newActions + , DL.append newLogs logsFromTrigger) -- `debug` ("New logs from trigger"++ show d ++">>>"++show newLogs) + + +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 (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.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} + poolFlowMap (Just (ad:ads)) rates calls rAssump log + | 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 --- `debug` ("ending at date " ++ show (getDate ad)) + (finalDeal,_,newLogs) <- foldM (performActionWrap (getDate ad)) (t,runContext,log) cleanUpActions + 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,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 (\(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} + -- newScheduleFlowMap = Map.map (over CF.cashflowTxn (cutBy Exc Future d)) (fromMaybe Map.empty (getScheduledCashflow t Nothing)) + 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 (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) + (dRunWithTrigger1,rc3,ads3,newLogs1) <- runTriggers (dAfterAction,rc2,ads2) d EndCollectionWF -- `debug` ("PoolCollection: Pt 04"++ show d++">> context flow"++show (runPoolFlow rc2))-- `debug` ("End collection action"++ show waterfallToExe) + run (increasePoolCollectedPeriod dRunWithTrigger1 ) + (runPoolFlow rc3) + (Just ads3) + rates + calls + rAssump + (DL.concat [newLogs0,newLogs,eopActionsLog,newLogs1]) + else + run t poolFlowMap (Just ads) rates calls rAssump log + + RunWaterfall d "" -> + let + runContext = RunContext poolFlowMap rAssump rates + waterfallKey = if Map.member (W.DistributionDay dStatus) waterfallM then + W.DistributionDay dStatus + else + W.DefaultDistribution + + waterfallToExe = Map.findWithDefault [] waterfallKey waterfallM + callTest = fst $ fromMaybe ([]::[Pre],[]::[Pre]) calls + in + do + (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) ) + if flag then + do + let newStLogs = if null cleanUpActions then + [DealStatusChangeTo d dStatus Called "Call by triggers before waterfall distribution"] + else + [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 (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)) + (dRunWithTrigger1, rc3, ads2, newLogs2) <- runTriggers (dAfterWaterfall,rc2,ads1) d EndDistributionWF -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall >>"++ show (runPoolFlow rc2)++" collected >>"++ show (pool dAfterWaterfall)) + run (increaseBondPaidPeriod dRunWithTrigger1) + (runPoolFlow rc3) + (Just ads2) + rates + calls + rAssump + (DL.concat [newLogsWaterfall, newLogs2 ,logsBeforeDist,DL.fromList [RunningWaterfall d waterfallKey]]) -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall 3>>"++ show (pool dRunWithTrigger1)++" status>>"++ show (status dRunWithTrigger1)) + + -- Custom waterfall execution action from custom dates + RunWaterfall d wName -> + let + runContext = RunContext poolFlowMap rAssump rates + waterfallKey = W.CustomWaterfall wName + in + do + waterfallToExe <- maybeToEither + ("No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) $ + Map.lookup waterfallKey waterfallM + let logsBeforeDist =[ WarningMsg (" No waterfall distribution found on date "++show d++" with waterfall key "++show waterfallKey) + | Map.notMember waterfallKey waterfallM ] + (dAfterWaterfall, rc2, newLogsWaterfall) <- foldM (performActionWrap d) (t,runContext,log) waterfallToExe -- `debug` (show d ++ " running action"++ show waterfallToExe) + run dAfterWaterfall (runPoolFlow rc2) (Just ads) rates calls rAssump + (DL.concat [newLogsWaterfall,DL.fromList (logsBeforeDist ++ [RunningWaterfall d waterfallKey])]) -- `debug` ("size of logs"++ show (length newLogsWaterfall)++ ">>"++ show d++ show (length logsBeforeDist)) + + EarnAccInt d accName -> + let + newAcc = Map.adjust (A.depositInt d) accName accMap + in + run (t {accounts = newAcc}) poolFlowMap (Just ads) rates calls rAssump log + + AccrueFee d feeName -> + do + fToAcc <- maybeToEither + ("Failed to find fee "++feeName) + (Map.lookup feeName feeMap) + newF <- calcDueFee t d fToAcc + let newFeeMap = Map.fromList [(feeName,newF)] <> feeMap + run (t{fees=newFeeMap}) poolFlowMap (Just ads) rates calls rAssump log + + ResetLiqProvider d liqName -> + case liqProvider t of + Nothing -> run t poolFlowMap (Just ads) rates calls rAssump log + (Just mLiqProvider) + -> let -- update credit + newLiqMap = Map.adjust (updateLiqProvider t d) liqName mLiqProvider + in + run (t{liqProvider = Just newLiqMap}) poolFlowMap (Just ads) rates calls rAssump log + + ResetLiqProviderRate d liqName -> + case liqProvider t of + Nothing -> run t poolFlowMap (Just ads) rates calls rAssump log + (Just mLiqProvider) + -> let -- update rate + newLiqMap = Map.adjust (updateLiqProviderRate t d (fromMaybe [] rates)) liqName mLiqProvider + in + run (t{liqProvider = Just newLiqMap}) poolFlowMap (Just ads) rates calls rAssump log + + DealClosed d -> + let + w = Map.findWithDefault [] W.OnClosingDay (waterfall t) + rc = RunContext poolFlowMap rAssump rates + logForClosed = [RunningWaterfall d W.OnClosingDay| not (null w)] + in + do + newSt <- case dStatus of + (PreClosing st) -> Right st + _ -> Left $ "DealClosed action is not in PreClosing status but got"++ show dStatus + (newDeal, newRc, newLog) <- foldM (performActionWrap d) (t, rc, log) w -- `debug` ("ClosingDay Action:"++show w) + run newDeal{status=newSt} (runPoolFlow newRc) (Just ads) rates calls rAssump + (DL.concat [newLog, DL.fromList ([DealStatusChangeTo d (PreClosing newSt) newSt "By Deal Close"]++logForClosed)]) -- `debug` ("new st at closing"++ show newSt) + + ChangeDealStatusTo d s -> run (t{status=s}) poolFlowMap (Just ads) rates calls rAssump log + + CalcIRSwap d sn -> + case rateSwap t of + Nothing -> Left $ " No rate swaps modeled when looking for "++ sn + Just rSwap -> + 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 + run (t{rateSwap = Just newRateSwap_acc}) poolFlowMap (Just ads) rates calls rAssump log + + SettleIRSwap d sn -> + case rateSwap t of + Nothing -> Left $ " No rate swaps modeled when looking for "++ sn + Just rSwap -> + do + acc <- case HE.rsSettleDates (rSwap Map.! sn) of + Nothing -> Left $ "No settle date found for "++ sn + Just (_, _accName) -> Right $ accMap Map.! _accName + let accBal = A.accBalance acc + let rs = rSwap Map.! sn + let settleAmt = HE.rsNetCash rs + let accName = A.accName acc + case (settleAmt <0, accBal < abs settleAmt) of + (True, True) -> + let + newAcc = Map.adjust (A.draw accBal d (SwapOutSettle sn)) accName accMap + newRsMap = Just $ Map.adjust (HE.payoutIRS d accBal) sn rSwap + in + run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump + $ DL.snoc log (WarningMsg $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn) + -- Left $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn + (True, False) -> + let + newAcc = Map.adjust (A.draw (abs settleAmt) d (SwapOutSettle sn)) accName accMap + newRsMap = Just $ Map.adjust (HE.payoutIRS d settleAmt) sn rSwap + in + run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log + (False, _) -> + let + newAcc = Map.adjust (A.deposit settleAmt d (SwapInSettle sn)) accName accMap + newRsMap = Just $ Map.adjust (HE.receiveIRS d) sn rSwap + in + run (t{accounts = newAcc, rateSwap = newRsMap}) poolFlowMap (Just ads) rates calls rAssump log + + AccrueCapRate d cn -> + case rateCap t of + Nothing -> Left $ " No rate cap found for "++ cn + Just rCap -> + let + _rates = fromMaybe [] rates + in + do + newRateCap <- adjustM (accrueRC t d _rates) cn rCap + run (t{rateCap = Just newRateCap}) poolFlowMap (Just ads) rates calls rAssump log + + InspectDS d dss -> + do + newlog <- inspectListVars t d dss + run t poolFlowMap (Just ads) rates calls rAssump $ DL.append log (DL.fromList newlog) -- `debug` ("Add log"++show newlog) + + ResetBondRate d bn -> + let + rateList = fromMaybe [] rates + bnd = bndMap Map.! bn + in + do + newBnd <- setBondNewRate t d rateList bnd + run t{bonds = Map.fromList [(bn,newBnd)] <> bndMap} poolFlowMap (Just ads) rates calls rAssump log + + StepUpBondRate d bn -> + let + bnd = bndMap Map.! bn -- `debug` ("StepUpBondRate--------------"++ show bn) + in + do + -- newBnd <- setBondStepUpRate t d bnd `debug` ("StepUpBondRate"++ show d++ show bn) + newBndMap <- adjustM (setBondStepUpRate t d (fromMaybe [] rates)) bn bndMap + run t{bonds = newBndMap } poolFlowMap (Just ads) rates calls rAssump log + + ResetAccRate d accName -> + do + newAccMap <- adjustM + (\a@(A.Account _ _ (Just (A.InvestmentAccount idx spd dp dp1 lastDay _)) _ _) + -> do + newRate <- AP.lookupRate (fromMaybe [] rates) (idx,spd) d + let accWithNewInt = A.depositInt d a + return accWithNewInt { A.accInterest = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)}) + accName accMap + run t{accounts = newAccMap} poolFlowMap (Just ads) rates calls rAssump log + + BuildReport sd ed -> + let + cashReport = Rpt.buildCashReport t sd ed + in + do + bsReport <- Rpt.buildBalanceSheet t ed + let newlog = FinancialReport sd ed bsReport cashReport + run t poolFlowMap (Just ads) rates calls rAssump $ DL.snoc log newlog -- `debug` ("new log"++ show ed++ show newlog) + + FireTrigger d cyc n -> + let + triggerFired = case mTrgMap of + Nothing -> error "trigger is empty for override" + Just tm -> Map.adjust (Map.adjust (set trgStatusLens True) n) cyc tm + triggerEffects = do + tm <- mTrgMap + cycM <- Map.lookup cyc tm + trg <- Map.lookup n cycM + return $ trgEffects trg + + runContext = RunContext poolFlowMap rAssump rates + in + do + (newT, rc@(RunContext newPool _ _), adsFromTrigger, newLogsFromTrigger) + <- case triggerEffects of + Nothing -> Right (t, runContext, ads, DL.empty) -- `debug` "Nothing found on effects" + Just efs -> runEffects (t, runContext, ads, DL.empty) d efs + let (oldStatus,newStatus) = (status t,status newT) + let stChangeLogs = DL.fromList [DealStatusChangeTo d oldStatus newStatus "by Manual fireTrigger" | oldStatus /= newStatus] + run newT {triggers = Just triggerFired} newPool (Just ads) rates calls rAssump $ DL.concat [log,stChangeLogs,newLogsFromTrigger] + + MakeWhole d spd walTbl -> + let + 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 (\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 >))))) + bondWal + let bondPricingCurve = Map.map + (\x -> IRateCurve [ TsPoint d x,TsPoint (getDate (last ads)) x] ) + bondSprd + let bondPricingResult = Map.intersectionWithKey (\k v1 v2 -> L.priceBond d v2 v1) (bonds runDealWithSchedule) bondPricingCurve + let depositBondFlow = Map.intersectionWith + (\bnd (PriceResult pv _ _ _ _ _ _) -> + let + ostBal = L.getCurBalance bnd + prinToPay = min pv ostBal + intToPay = max 0 (pv - prinToPay) + bnd1 = L.payPrin d prinToPay bnd + in + L.payYield d intToPay bnd1) + (bonds t) + bondPricingResult + 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 + newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap + in + do + let bndFunded = L.fundWith d fundAmt $ bndMap Map.! bName + run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap} + poolFlowMap (Just ads) rates calls rAssump log + + FundBond d (Just p) bName accName fundAmt -> + let + newAcc = Map.adjust (A.deposit fundAmt d (FundWith bName fundAmt)) accName accMap + in + do + flag <- testPre d t p + case flag of + False -> run t poolFlowMap (Just ads) rates calls rAssump (DL.snoc log (WarningMsg ("Failed to fund bond"++ bName++ ":" ++show p))) + True -> + do + let bndFunded = L.fundWith d fundAmt $ bndMap Map.! bName + run t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap} + poolFlowMap (Just ads) rates calls rAssump log + + + IssueBond d Nothing bGroupName accName bnd mBal mRate -> + run t poolFlowMap (Just ((IssueBond d (Just (Always True)) bGroupName accName bnd mBal mRate):ads)) rates calls rAssump log + + IssueBond d (Just p) bGroupName accName bnd mBal mRate -> + do + flag <- testPre d t p + case flag of + False -> run t poolFlowMap (Just ads) rates calls rAssump (DL.snoc log (WarningMsg ("Failed to issue to bond group"++ bGroupName++ ":" ++show p))) + True -> let + newBndName = L.bndName bnd + in + do + newBalance <- case mBal of + Just _q -> queryCompound t d (patchDateToStats d _q) + Nothing -> Right . toRational $ L.originBalance (L.bndOriginInfo bnd) + newRate <- case mRate of + Just _q -> queryCompound t d (patchDateToStats d _q) + Nothing -> Right $ L.originRate (L.bndOriginInfo bnd) + let newBonds = case Map.lookup bGroupName bndMap of + Nothing -> bndMap + Just L.Bond {} -> bndMap + Just (L.BondGroup bndGrpMap pt) -> let + bndOInfo = (L.bndOriginInfo bnd) {L.originDate = d, L.originRate = newRate, L.originBalance = fromRational newBalance } + bndToInsert = bnd {L.bndOriginInfo = bndOInfo, + L.bndDueIntDate = Just d, + L.bndLastIntPay = Just d, + L.bndLastPrinPay = Just d, + L.bndRate = fromRational newRate, + L.bndBalance = fromRational newBalance} + in + Map.insert bGroupName + (L.BondGroup (Map.insert newBndName bndToInsert bndGrpMap) pt) + bndMap + + let issuanceProceeds = fromRational newBalance + let newAcc = Map.adjust (A.deposit issuanceProceeds d (IssuanceProceeds newBndName)) + accName + accMap + run t{bonds = newBonds, accounts = newAcc} poolFlowMap (Just ads) rates calls rAssump log + RefiBondRate d accName bName iInfo -> + let + -- settle accrued interest + -- TODO rebuild bond rate reset actions + lstDate = getDate (last ads) + isResetActionEvent (ResetBondRate _ bName ) = False + isResetActionEvent _ = True + filteredAds = filter isResetActionEvent ads + newRate = L.getBeginRate iInfo + in + do + nBnd <- calcDueInt t d $ bndMap Map.! bName + let dueIntToPay = L.getTotalDueInt nBnd + let ((shortfall,drawAmt),newAcc) = A.tryDraw dueIntToPay d (PayInt [bName]) (accMap Map.! accName) + let newBnd = set L.bndIntLens iInfo $ L.payInt d drawAmt nBnd + let resetDates = L.buildRateResetDates newBnd d lstDate + -- let bResetActions = [ ResetBondRate d bName 0 | d <- resetDates ] + -- 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 newAds = sortBy sortActionOnDate $ filteredAds ++ bResetActions + run t{bonds = newBndMap, accounts = newAccMap} poolFlowMap (Just newAds) rates calls rAssump log + + RefiBond d accName bnd -> Left "Undefined action: RefiBond" + + TestCall d -> + let + timeBasedTests::[Pre] = snd (fromMaybe ([],[]) calls) + in + do + flags::[Bool] <- sequenceA $ [ (testPre d t pre) | pre <- timeBasedTests ] + case any id flags of + True -> + let + runContext = RunContext poolFlowMap rAssump rates + newStLogs = if null cleanUpActions then + DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call"] + else + DL.fromList [DealStatusChangeTo d dStatus Called "by Date-Based Call", RunningWaterfall d W.CleanUp] + in + do + (dealAfterCleanUp, rc_, newLogWaterfall_ ) <- foldM (performActionWrap d) (t, runContext, log) cleanUpActions + endingLogs <- Rpt.patchFinancialReports dealAfterCleanUp d newLogWaterfall_ + 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 (\(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 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 (t, log ,empty) -- `debug` ("End with pool CF is []") + + + +-- reserved for future used +data ExpectReturn = DealLogs + | AssetLevelFlow + deriving (Show,Generic,Ord,Eq) + + +-- priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [(Date,Balance)]) +priceBondIrr :: AP.IrrType -> [Txn] -> Either String (Rate, [Txn]) +-- No projected transaction, use history cashflow only +priceBondIrr AP.BuyBond {} [] = Left "No transaction to buy the bond" +priceBondIrr (AP.HoldingBond historyCash _ _) [] + = let + (ds,vs) = unzip historyCash + txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ] + in + do + irr <- Analytics.calcIRR ds vs + return (irr, txns') +-- Projected transaction and hold to maturity +priceBondIrr (AP.HoldingBond historyCash holding Nothing) txns + = let + begBal = (getTxnBegBalance . head) txns + holdingPct = divideBB holding begBal + bProjectedTxn = scaleTxn holdingPct <$> txns -- `debug` ("holding pct"++ show holding ++"/" ++ show begBal ++" : " ++ show holdingPct) + (ds,vs) = unzip historyCash + (ds2,vs2) = (getDate <$> bProjectedTxn, getTxnAmt <$> bProjectedTxn) -- `debug` ("projected txn position"++ show bProjectedTxn) + + txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ] + in + do + irr <- Analytics.calcIRR (ds++ds2) (vs++vs2) -- `debug` ("projected holding"++ show (ds2,vs2)) + return (irr, txns' ++ bProjectedTxn) + +-- TODO: need to use DC from bond +-- Projected transaction and sell at a Date +priceBondIrr (AP.HoldingBond historyCash holding (Just (sellDate, sellPricingMethod))) txns + = let + -- history cash + (ds,vs) = unzip historyCash + txns' = [ BondTxn d 0 0 0 0 v 0 0 Nothing Types.Empty | (d,v) <- historyCash ] + + begBal = (getTxnBegBalance . head) txns + holdingPct = toRational $ holding / begBal + -- assume cashflow of sell date belongs to seller(owner) + (bProjectedTxn',futureFlow') = splitByDate txns sellDate EqToLeft + (bProjectedTxn,futureFlow) = ((scaleTxn holdingPct) <$> bProjectedTxn',(scaleTxn holdingPct) <$> futureFlow') + -- projected cash + (ds2,vs2) = (getDate <$> bProjectedTxn, getTxnAmt <$> bProjectedTxn) + -- accrued interest + accruedInt = L.backoutAccruedInt sellDate epocDate (bProjectedTxn++futureFlow) + (ds3,vs3) = (sellDate, accruedInt) -- `debug` ("accrued interest"++ show (accruedInt,sellDate)) + -- sell price + sellPrice = case sellPricingMethod of + BondBalanceFactor f -> case bProjectedTxn of + [] -> mulBR begBal (f * holdingPct) + _txns -> mulBR (getTxnBalance (last _txns)) f + (ds4,vs4) = (sellDate, sellPrice) -- `debug` ("sale price, date"++ show (sellPrice,sellDate)) + in + do + irr <- Analytics.calcIRR (ds++ds2++[ds3]++[ds4]) (vs++vs2++[vs3]++[vs4]) -- `debug` ("vs:"++ show vs++ "vs2:"++ show vs2++ "vs3:"++ show vs3++ "vs4:"++ show vs4 ++">>> ds "++ show ds++ "ds2"++ show ds2++ "ds3"++ show ds3++ "ds4"++ show ds4) + return (irr, txns'++ bProjectedTxn++ [(BondTxn sellDate 0 vs3 sellPrice 0 (sellPrice+vs3) 0 0 Nothing Types.Empty)]) + +-- Buy and hold to maturity +priceBondIrr (AP.BuyBond dateToBuy bPricingMethod (AP.ByCash cash) Nothing) txns + | null futureFlow' = Left "No transaction to buy bond" + | otherwise + = let + -- balance of bond on buy date + nextTxn = head futureFlow' + balAsBuyDate = getTxnBegBalance nextTxn + buyPrice = case bPricingMethod of + BondBalanceFactor f -> mulBR balAsBuyDate f + buyPaidOut = min buyPrice cash + buyPct = divideBB buyPaidOut buyPrice + boughtTxns = scaleTxn buyPct <$> futureFlow' + -- buy price (including accrued interest) + + accuredInt = let + --TODO what about interest over interest + accruedInt' = calcInt balAsBuyDate dateToBuy (getDate nextTxn) (getTxnRate nextTxn) DC_ACT_365F + x = nextTxn + totalInt' = (fromMaybe 0) <$> [(preview (_BondTxn . _3 ) x), (preview (_BondTxn . _7 ) x), (preview (_BondTxn . _8 ) x)] + in + sum(totalInt') - accruedInt' + + (ds1, vs1) = (dateToBuy, negate (buyPaidOut + accuredInt)) + (ds2, vs2) = (getDate <$> futureFlow', getTxnAmt <$> boughtTxns) + in + do + 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) + (bProjectedTxn',futureFlow') = splitByDate txns dateToBuy EqToLeft + + +priceBonds :: Ast.Asset a => TestDeal a -> AP.BondPricingInput -> Either String (Map.Map String PriceResult) +-- Price bond via discount future cashflow +priceBonds t (AP.DiscountCurve d dc) = Right $ Map.map (L.priceBond d dc) (viewBondsInMap t) +-- Run Z-Spread +priceBonds t@TestDeal {bonds = bndMap} (AP.RunZSpread curve bondPrices) + = sequenceA $ + Map.mapWithKey + (\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) + = let + -- Date + d = getNextBondPayDate t + -- get projected bond txn + projectedTxns xs = snd $ splitByDate xs d EqToRight + -- (Maybe Bond,IrrType) + bndMap' = Map.mapWithKey (\k v -> (getBondByName t True k, v)) bMapInput + -- (Rate, [(date, cash)]) + bndMap'' = Map.mapWithKey (\bName (Just b, v) -> + do + let _irrTxns = projectedTxns (getAllTxns b) + (_irr, flows) <- priceBondIrr v _irrTxns + return (IrrResult (fromRational _irr) flows)) + bndMap' + in + sequenceA bndMap'' + + +-- ^ split call option assumption , +-- lefts are for waterfall payment days +-- rights are for date-based calls +splitCallOpts :: AP.CallOpt -> ([Pre],[Pre]) +splitCallOpts (AP.CallPredicate ps) = (ps,[]) +splitCallOpts (AP.LegacyOpts copts) = + let + cFn (C.PoolBalance bal) = If L (CurrentPoolBalance Nothing) bal + cFn (C.BondBalance bal) = If L CurrentBondBalance bal + cFn (C.PoolFactor r) = IfRate L (PoolFactor Nothing) (fromRational r) + cFn (C.BondFactor r) = IfRate L BondFactor (fromRational r) + cFn (C.OnDate d) = IfDate E d + cFn (C.AfterDate d) = IfDate G d + cFn (C.And _opts) = Types.All [ cFn o | o <- _opts ] + cFn (C.Or _opts) = Types.Any [ cFn o | o <- _opts ] + cFn (C.Pre p) = p + in + ([ cFn copt | copt <- copts ],[]) +-- legacyCallOptConvert (AP.CallOptions opts) = concat [ legacyCallOptConvert o | o <- opts ] +splitCallOpts (AP.CallOnDates dp ps) = ([],ps) + + +-- , +readCallOptions :: [AP.CallOpt] -> ([Pre],[Pre]) +readCallOptions [] = ([],[]) +readCallOptions opts = + let + result = splitCallOpts <$> opts + in + (concat (fst <$> result), concat (snd <$> result)) + + +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 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) + bndPricing <- case mPricing of + (Just p) -> priceBonds finalDeal p + Nothing -> Right Map.empty + return (finalDeal + , poolFlowUsedNoEmpty + , getRunResult finalDeal ++ V.validateRun finalDeal ++ DL.toList (DL.append logs (unCollectedPoolFlowWarning osPoolFlow)) + , bndPricing + , osPoolFlow & mapped . _1 . CF.cashflowTxn %~ CF.dropTailEmptyTxns + & mapped . _2 . _Just . each . CF.cashflowTxn %~ CF.dropTailEmptyTxns + ) -- `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) + -- extract Revolving Assumption + mRevolvingCtx = case mRevolving of + Nothing -> Nothing + Just (AP.AvailableAssets rp rperf) -> Just (Map.fromList [("Consol", (rp, rperf))]) + Just (AP.AvailableAssetsBy rMap) -> Just rMap + -- TODO: need to add warning if uncollected pool flow is not empty + unCollectedPoolFlowWarning pMap = if sum (Map.elems (Map.map (CF.sizeCashFlowFrame . view _1) pMap)) > 0 then + DL.singleton $ WarningMsg "Oustanding pool cashflow hasn't been collected yet" + 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 +getRunResult :: Ast.Asset a => TestDeal a -> [ResultComponent] +getRunResult t = os_bn_i ++ os_bn_b -- `debug` ("Done with get result") + where + bs = viewDealAllBonds t + 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) + + +-- | 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 + consolePoolFlowFn = over CF.cashflowTxn CF.dropTailEmptyTxns + rmAssetLevelFn xs + | S.member AssetLevelFlow er = xs + | otherwise = [] + in + 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.PoolCashflow -> TestDeal a +-- ^ append cashflow frame (consolidate by a date) into deals collected pool +appendCollectedCF d t@TestDeal { pool = pt } poolInflowMap + = let + newPt = case pt of + MultiPool poolM -> + MultiPool $ + Map.foldrWithKey + (\k (CF.CashFlowFrame st txnCollected, mAssetFlow) acc -> + let + 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 + -- 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 + poolInflowMap + ResecDeal uds -> + ResecDeal $ + Map.foldrWithKey + (\k (CF.CashFlowFrame _ newTxns, _) acc-> + Map.adjust (over uDealFutureTxn (++ newTxns)) k acc) + uds + poolInflowMap + in + 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 $ set (mapped . P.poolFutureCf) Nothing pm + ResecDeal uds -> ResecDeal uds + 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)] +-- schedule cashflow with stress assumption +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 +-- use interest rate assumption +runPool (P.Pool as _ _ asof _ _) Nothing mRates + = do + cf <- sequenceA $ parMap rdeepseq + (\x -> Ast.calcCashflow x asof mRates) + as + return [ (x, Map.empty) | x <- cf ] +-- asset cashflow with credit stress +---- By pool level +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 asof _ _) (Just (AP.ByIndex idxAssumps)) mRates = + let + numAssets = length as + in + do + _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 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] + -- -> [c] -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)] + matchAssets [] _ [] = Right [(CF.CashFlowFrame (0,epocDate,Nothing) [], Map.empty)] + matchAssets cfs [] [] = sequenceA cfs + -- matchAssets cfs [] astList = sequenceA $ cfs ++ ((\x -> (\y -> (y, Map.empty)) <$> (Ast.calcCashflow x asof mRates)) <$> astList) + matchAssets cfs [] astList = let + poolCfs = parMap rdeepseq (\x -> Ast.calcCashflow x asof mRates) astList + poolCfs' = (\x -> (, Map.empty) <$> x) <$> poolCfs + in + sequenceA $ cfs ++ poolCfs' + matchAssets cfs (rule:rules) astList = + case rule of + AP.ObligorById ids assetPerf + -> let + idSet = S.fromList ids + (matchedAsts,unMatchedAsts) = partition + (\x -> case Ast.getObligorId x of + Just oid -> S.member oid idSet + Nothing -> False) + astList + matchedCfs = parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) matchedAsts + in + matchAssets (cfs ++ matchedCfs) rules unMatchedAsts + AP.ObligorByTag tags tagRule assetPerf -> + let + obrTags = S.fromList tags + + matchRuleFn AP.TagEq s1 s2 = s1 == s2 + matchRuleFn AP.TagSubset s1 s2 = s1 `S.isSubsetOf` s2 + matchRuleFn AP.TagSuperset s1 s2 = s2 `S.isSubsetOf` s1 + matchRuleFn AP.TagAny s1 s2 = not $ S.null $ S.intersection s1 s2 + matchRuleFn (AP.TagNot tRule) s1 s2 = not $ matchRuleFn tRule s1 s2 + + (matchedAsts,unMatchedAsts) = partition (\x -> matchRuleFn tagRule (Ast.getObligorTags x) obrTags) astList + matchedCfs = parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) matchedAsts + in + matchAssets (cfs ++ matchedCfs) rules unMatchedAsts + + AP.ObligorByField fieldRules assetPerf -> + let + matchRuleFn (AP.FieldIn fv fvals) Nothing = False + matchRuleFn (AP.FieldIn fv fvals) (Just fm) = case Map.lookup fv fm of + Just (Left v) -> v `elem` fvals + Nothing -> False + matchRuleFn (AP.FieldCmp fv cmp dv) (Just fm) = case Map.lookup fv fm of + Just (Right v) -> case cmp of + G -> v > dv + L -> v < dv + GE -> v >= dv + LE -> v <= dv + Nothing -> False + matchRuleFn (AP.FieldInRange fv rt dv1 dv2) (Just fm) = + case Map.lookup fv fm of + Just (Right v) -> case rt of + II -> v <= dv2 && v >= dv1 + IE -> v <= dv2 && v > dv1 + EI -> v < dv2 && v >= dv1 + EE -> v < dv2 && v > dv1 + _ -> False + Nothing -> False + matchRuleFn (AP.FieldNot fRule) fm = not $ matchRuleFn fRule fm + + matchRulesFn fs fm = all (`matchRuleFn` fm) fs + + (matchedAsts,unMatchedAsts) = partition (matchRulesFn fieldRules . Ast.getObligorFields) astList + matchedCfs = parMap rdeepseq (\x -> Ast.projCashflow x asof assetPerf mRates) matchedAsts + in + matchAssets (cfs ++ matchedCfs) rules unMatchedAsts + AP.ObligorByDefault assetPerf -> + matchAssets + (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 $ "[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 (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 + 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.PoolCashflow -> PoolType a -> PoolType a +patchScheduleFlow flowM pt = + case pt of + 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 +patchRuntimeBal balMap (MultiPool pM) + = MultiPool $ + Map.mapWithKey + (\k p -> over P.poolIssuanceStat + (Map.insert RuntimeCurrentPoolBalance (Map.findWithDefault 0.0 k balMap)) + p) + pM + +patchRuntimeBal balMap pt = pt + + +runPoolType :: Ast.Asset a => Bool -> PoolType a -> Maybe AP.ApplyAssumptionType + -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId CF.PoolCashflow) + +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 -> + 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 flag (ResecDeal dm) mAssumps mNonPerfAssump + = + let + assumpMap = 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 + ranMap = 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 (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 => 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 ] + in + do + (startDate,closingDate,firstPayDate,pActionDates,bActionDates,endDate,custWdates) <- populateDealDates (dates t) status + + let intEarnDates = A.buildEarnIntAction (Map.elems (accounts t)) endDate [] + let intAccRateResetDates = (A.buildRateResetDates endDate) <$> (Map.elems (accounts t)) + let iAccIntDates = [ EarnAccInt _d accName | (accName,accIntDates) <- intEarnDates , _d <- accIntDates ] + let iAccRateResetDates = concat [ [ResetAccRate _d accName | _d <- _ds] | rst@(Just (accName, _ds)) <- intAccRateResetDates, isJust rst ] + + --fee accrue dates + let _feeAccrueDates = F.buildFeeAccrueAction (Map.elems feeMap) endDate [] + let feeAccrueDates = [ AccrueFee _d _feeName | (_feeName,feeAccureDates) <- _feeAccrueDates , _d <- feeAccureDates ] + --liquidation facility + let liqResetDates = case liqProvider t of + Nothing -> [] + Just mLiqProvider -> + let + _liqResetDates = CE.buildLiqResetAction (Map.elems mLiqProvider) endDate [] + _liqRateResetDates = CE.buildLiqRateResetAction (Map.elems mLiqProvider) endDate [] + in + [ ResetLiqProvider _d _liqName |(_liqName,__liqResetDates) <- _liqResetDates , _d <- __liqResetDates ] + ++ + [ ResetLiqProviderRate _d _liqName |(_liqName,__liqResetDates) <- _liqRateResetDates , _d <- __liqResetDates ] + --inspect dates + let inspectDates = case mNonPerfAssump of + 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 + (s:_ds) = genSerialDatesTill2 II startDate dp endDate + in + [ BuildReport _sd _ed | (_sd,_ed) <- zip (s:_ds) _ds ] -- `debug` ("ds"++ show _ds) + _ -> [] + + let irUpdateSwapDates = case rateSwap t of + Nothing -> [] + Just rsm -> Map.elems $ Map.mapWithKey + (\k x -> let + resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) (HE.rsUpdateDates x) endDate + in + flip CalcIRSwap k <$> resetDs) + rsm + let irSettleSwapDates = case rateSwap t of + Nothing -> [] + Just rsm -> Map.elems $ Map.mapWithKey + (\k x@HE.RateSwap{ HE.rsSettleDates = sDates} -> + case sDates of + Nothing -> [] + Just (sdp,_) -> + let + resetDs = genSerialDatesTill2 EE (HE.rsStartDate x) sdp endDate + in + flip SettleIRSwap k <$> resetDs) + rsm + let rateCapSettleDates = case rateCap t of + Nothing -> [] + Just rcM -> Map.elems $ Map.mapWithKey + (\k x -> let + resetDs = genSerialDatesTill2 EE (HE.rcStartDate x) (HE.rcSettleDates x) endDate + in + flip AccrueCapRate k <$> resetDs) + rcM + -- bond rate resets + let bndRateResets = let + bndWithDate = Map.toList $ Map.map + (\b -> L.buildRateResetDates b closingDate endDate) + bndMap + in + [ ResetBondRate bdate bn | (bn, bdates) <- bndWithDate + , bdate <- bdates ] + + -- bond step ups events + let bndStepUpDates = let + bndWithDate = Map.toList $ Map.map + (\b -> L.buildStepUpDates b closingDate endDate) + bndMap + in + [ StepUpBondRate bdate bn | (bn, bdates) <- bndWithDate , bdate <- bdates ] + + -- mannual triggers + let mannualTrigger = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.fireTrigger = Just evts} -> [ FireTrigger d cycle n | (d,cycle,n) <- evts] + _ -> [] + + -- make whole assumption + let makeWholeDate = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.makeWholeWhen = Just (_d,_s,_t)} -> [MakeWhole _d _s _t] + _ -> [] + + -- issue bonds in the future + let bondIssuePlan = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.issueBondSchedule = Just bndPlan} + -> [ IssueBond _d mPre bGroupName accName b mBal mRate | TsPoint _d (AP.IssueBondEvent mPre bGroupName accName b mBal mRate) <- bndPlan] + ++ [FundBond _d mPre bName accName amount | TsPoint _d (AP.FundingBondEvent mPre bName accName amount) <- bndPlan] + _ -> [] + + -- refinance bonds in the future + let bondRefiPlan = case mNonPerfAssump of + Just AP.NonPerfAssumption{AP.refinance = Just bndPlan} + -> [ RefiBondRate _d accName bName iInfo | TsPoint _d (AP.RefiRate accName bName iInfo) <- bndPlan] + ++ [ RefiBond _d accName bnd | TsPoint _d (AP.RefiBond accName bnd) <- bndPlan] + + _ -> [] + + let extractTestDates (AP.CallOnDates dp _) = [TestCall x | x <- genSerialDatesTill2 EE startDate dp endDate ] + let extractTestDates _ = [] + -- extractTestDates (AP.CallOptions opts) = concat [ extractTestDates opt | opt <- opts ] + -- call test dates + let callDates = case mNonPerfAssump of + 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, stopTestDates + ,bondIssuePlan,bondRefiPlan,callDates, iAccRateResetDates + ,bndStepUpDates] + in + case (dates t,status) of + (PreClosingDates {}, PreClosing _) -> sortBy sortActionOnDate $ DealClosed closingDate:a + _ -> sortBy sortActionOnDate a + _actionDates = __actionDates++[HitStatedMaturity endDate] + in + case mNonPerfAssump of + 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 pairs } + -> foldr (\(feeName,feeFlow) accM -> Map.adjust (\v -> v {F.feeType = F.FeeFlow feeFlow}) feeName accM) feeMap pairs + 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 + ((\(_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)])) + else + _stats + return (t {fees = newFeeMap , pool = poolWithRunPoolBalance , stats = newStat} + , allActionDates + , pCollectionCfAfterCutoff + , pUnstressedAfterCutoff) + +-- ^ UI translation : to read pool cash +readProceeds :: PoolSource -> CF.TsRow -> Either String Balance +readProceeds CollectedInterest x = Right $ CF.mflowInterest x +readProceeds CollectedPrincipal x = Right $ CF.mflowPrincipal x +readProceeds CollectedRecoveries x = Right $ CF.mflowRecovery x +readProceeds CollectedPrepayment x = Right $ CF.mflowPrepayment x +readProceeds CollectedRental x = Right $ CF.mflowRental x +readProceeds CollectedPrepaymentPenalty x = Right $ CF.mflowPrepaymentPenalty x +readProceeds CollectedCash x = Right $ CF.tsTotalCash x +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.PoolCashflow -> [CF.TsRow] +extractTxnsFromFlowFrameMap mPids pflowMap = + 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.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 + let amt = sum amts + return $ Map.adjust (A.deposit amt d (PoolInflow mPids s)) an amap + where + txns = extractTxnsFromFlowFrameMap mPids pFlowMap + + +depositInflow d (W.CollectByPct mPids s splitRules) pFlowMap amap --TODO need to check 100% + = do + amts <- sequenceA $ readProceeds s <$> txns + let amt = sum amts + let amtsToAccs = [ (an, mulBR amt splitRate) | (splitRate, an) <- splitRules] + return $ + foldr + (\(accName,accAmt) accM -> + Map.adjust (A.deposit accAmt d (PoolInflow mPids s)) accName accM) + amap + amtsToAccs + where + txns = extractTxnsFromFlowFrameMap mPids pFlowMap + +-- ^ deposit cash to account by pool map CF and rules +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) diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs new file mode 100644 --- /dev/null +++ b/src/Deal/DealAction.hs @@ -0,0 +1,1439 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Deal.DealAction (performActionWrap,performAction,calcDueFee + ,testTrigger,RunContext(..),updateLiqProvider + ,calcDueInt,priceAssetUnion + ,priceAssetUnionList,inspectVars,inspectListVars) + where + +import qualified Accounts as A +import qualified Ledger as LD +import qualified Asset as Ast +import qualified Pool as P +import qualified Expense as F +import qualified Liability as L +import qualified CreditEnhancement as CE +import qualified Hedge as HE +import qualified Waterfall as W +import qualified Cashflow as CF +import qualified Assumptions as AP +import qualified AssetClass.AssetBase as ACM +import AssetClass.Mortgage +import AssetClass.Lease +import AssetClass.Loan +import AssetClass.Installment +import AssetClass.MixedAsset + +import qualified Call as C +import qualified InterestRate as IR +import qualified Analytics as AN + +import Deal.DealBase +import Deal.DealQuery +import Deal.DealDate + +import Stmt +import Lib +import Util +import DateUtil +import Types +import Revolving +import Triggers + +import qualified Data.Map as Map +import qualified Data.Time as T +import qualified Data.Set as S +import qualified Control.Lens as LS +import Data.List +import qualified Data.DList as DL +import Data.Fixed +import Data.Time.Clock +import Data.Maybe +import Data.Either +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 +import GHC.Generics +import Control.Applicative +import Debug.Trace +import Cashflow (CashFlowFrame(CashFlowFrame)) +import Control.Lens hiding (element) +import Control.Lens.TH +import Control.Lens.Extras (is) +import Control.Monad +import GHC.Real (infinity) +import Data.OpenApi (HasPatch(patch)) + +debug = flip trace + +-- ^ Test triggers +testTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Either String Trigger +testTrigger t d trigger@Trigger{trgStatus=st,trgCurable=curable,trgCondition=cond,trgStmt = tStmt} + | not curable && st = Right trigger + | otherwise = let + (memo, newStM) = testPre2 d t cond + in + do + newSt <- newStM + return trigger { trgStatus = newSt + , trgStmt = Stmt.appendStmt (TrgTxn d newSt (Stmt.Tag memo)) tStmt } + + +pricingAssets :: PricingMethod -> [(ACM.AssetUnion,AP.AssetPerf)] -> Maybe [RateAssumption] -> Date + -> Either String [PriceResult] +pricingAssets pm assetsAndAssump ras d + = let + pricingResults = (\(ast,perf) -> priceAssetUnion ast d pm perf ras) <$> assetsAndAssump + in + sequenceA pricingResults + + +-- actual payout amount to bond with due mounts +allocAmtToBonds :: W.PayOrderBy -> Amount -> [(L.Bond,Amount)] -> [(L.Bond,Amount)] +allocAmtToBonds W.ByProRataCurBal amt bndsWithDue + = zip (fst <$> bndsWithDue) $ prorataFactors (snd <$> bndsWithDue) amt +allocAmtToBonds theOrder amt bndsWithDue = + let + sortFn = case theOrder of + W.ByName -> (\(b1,_) (b2,_) -> compare (L.bndName b1) (L.bndName b2)) + W.ByCurrentRate -> (\(b1,_) (b2,_) -> compare (L.bndRate b2) (L.bndRate b1)) + W.ByMaturity -> (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.maturityDate bo1) (L.maturityDate bo2)) + W.ByStartDate -> (\(b1@L.Bond{L.bndOriginInfo=bo1},_) (b2@L.Bond{L.bndOriginInfo=bo2},_) -> compare (L.originDate bo1) (L.originDate bo2)) + -- TODO: how to handle if now names found in the bonds + -- W.ByCustomNames names -> (\(b1,_) (b2,_) -> compare (findIndex (== (L.bndName b1)) names) (findIndex (== (L.bndName b2)) names)) + W.ByCustomNames names -> (\(b1,_) (b2,_) -> compare (elemIndex (L.bndName b1) names) (elemIndex (L.bndName b2) names)) + orderedBonds = sortBy sortFn bndsWithDue + orderedAmt = snd <$> orderedBonds + in + zip + (fst <$> orderedBonds) + $ paySeqLiabilitiesAmt amt orderedAmt + + +calcDueFee :: Ast.Asset a => TestDeal a -> Date -> F.Fee -> Either String F.Fee +calcDueFee t calcDay f@(F.Fee fn (F.FixFee amt) fs fd fdDay fa _ _) + | isJust fdDay = Right f + | calcDay >= fs && isNothing fdDay = Right f { F.feeDue = amt, F.feeDueDate = Just calcDay} -- `debug` ("DEBUG--> init with amt "++show(fd)++show amt) + | otherwise = Right f + +calcDueFee t calcDay f@(F.Fee fn (F.AnnualRateFee feeBase r) fs fd Nothing fa lpd _) + | calcDay >= fs = calcDueFee t calcDay f {F.feeDueDate = Just fs } + | otherwise = Right f + +-- ^ annualized % fee base on pool balance amount +calcDueFee t@TestDeal{pool = pool} calcDay f@(F.Fee fn (F.AnnualRateFee feeBase _r) fs fd (Just _fdDay) fa lpd _) + = let + accrueStart = _fdDay + patchedDs = patchDatesToStats t accrueStart calcDay feeBase + in + do + r <- queryCompound t calcDay _r + baseBal <- queryCompound t calcDay patchedDs + let newDue = baseBal * r + return f { F.feeDue=fd+ fromRational newDue, F.feeDueDate = Just calcDay } + +calcDueFee t calcDay f@(F.Fee fn (F.PctFee ds _r ) fs fd fdDay fa lpd _) + = let + lastBegDay = fromMaybe fs fdDay + in + do + r <- queryCompound t calcDay _r + baseBal <- queryCompound t calcDay (patchDateToStats calcDay ds) + return f { F.feeDue = fd + fromRational (baseBal * r), F.feeDueDate = Just calcDay } + +calcDueFee t calcDay f@(F.Fee fn (F.FeeFlow ts) fs fd _ fa mflpd _) + = Right $ + f{ F.feeDue = newFeeDue ,F.feeDueDate = Just calcDay ,F.feeType = F.FeeFlow futureDue} + where + (currentNewDue,futureDue) = splitTsByDate ts calcDay + cumulativeDue = sumValTs currentNewDue + newFeeDue = cumulativeDue + fd + +calcDueFee t calcDay f@(F.Fee fn (F.RecurFee p amt) fs fd mLastAccDate fa _ _) + | periodGaps == 0 = Right f + | otherwise = Right f { F.feeDue = amt * fromIntegral periodGaps + fd + , F.feeDueDate = Just (T.addDays 1 calcDay) } + where + accDates = case mLastAccDate of + Nothing -> genSerialDatesTill2 NO_IE (T.addDays 1 fs) p calcDay + Just lastAccDate -> genSerialDatesTill2 NO_IE lastAccDate p calcDay + periodGaps = length accDates + +calcDueFee t calcDay f@(F.Fee fn (F.NumFee p s amt) fs fd Nothing fa lpd _) + | calcDay >= fs = calcDueFee t calcDay f {F.feeDueDate = Just fs } + | otherwise = Right f + +calcDueFee t calcDay f@(F.Fee fn (F.NumFee p s amt) fs fd (Just _fdDay) fa lpd _) + | _fdDay == calcDay = Right f + | periodGap == 0 = Right f + | otherwise = do + baseCount <- queryCompound t calcDay (patchDateToStats calcDay s) + let newFeeDueAmt = (fromRational baseCount) * amt * fromIntegral periodGap -- `debug` ("amt"++show amt++">>"++show baseCount++">>"++show periodGap) + return f { F.feeDue = fd+newFeeDueAmt , F.feeDueDate = Just calcDay } + where + dueDates = projDatesByPattern p _fdDay (pred calcDay) + periodGap = length dueDates -- `debug` ("Due Dates"++ show dueDates) + +calcDueFee t calcDay f@(F.Fee fn (F.TargetBalanceFee dsDue dsPaid) fs fd _ fa lpd _) + = do + let dsDueD = patchDateToStats calcDay dsDue + let dsPaidD = patchDateToStats calcDay dsPaid + dueAmt <- max 0 <$> (liftA2) (-) (queryCompound t calcDay dsDueD) (queryCompound t calcDay dsPaidD) + return f { F.feeDue = fromRational dueAmt, F.feeDueDate = Just calcDay} + +calcDueFee t@TestDeal{ pool = pool } calcDay f@(F.Fee fn (F.ByCollectPeriod amt) fs fd fdday fa lpd _) + = Right $ f {F.feeDue = dueAmt + fd, F.feeDueDate = Just calcDay} + where + txnsDates = getDate <$> getAllCollectedTxnsList t (Just [PoolConsol]) + pastPeriods = case fdday of + Nothing -> subDates II fs calcDay txnsDates + Just lastFeeDueDay -> subDates EI lastFeeDueDay calcDay txnsDates + dueAmt = fromRational $ mulBInt amt (length pastPeriods) + +calcDueFee t calcDay f@(F.Fee fn (F.AmtByTbl _ ds tbl) fs fd fdday fa lpd _) + = do + lookupVal <- queryCompound t calcDay (patchDateToStats calcDay ds) + let dueAmt = fromMaybe 0.0 $ lookupTable tbl Up ( fromRational lookupVal >=) + return f {F.feeDue = dueAmt + fd, F.feeDueDate = Just calcDay} + + +calcDueFee t calcDay f@(F.Fee fn (F.FeeFlowByPoolPeriod pc) fs fd fdday fa lpd stmt) + = do + currentPoolPeriod <- queryCompound t calcDay (DealStatInt PoolCollectedPeriod) + feePaidAmt <- queryCompound t calcDay (FeePaidAmt [fn]) + let dueAmt = fromMaybe 0 $ getValFromPerCurve pc Past Inc (succ (floor (fromRational currentPoolPeriod))) + return f {F.feeDue = max 0 (dueAmt - fromRational feePaidAmt) + fd, F.feeDueDate = Just calcDay} + +calcDueFee t calcDay f@(F.Fee fn (F.FeeFlowByBondPeriod pc) fs fd fdday fa lpd stmt) + = do + currentBondPeriod <- queryCompound t calcDay (DealStatInt BondPaidPeriod) + feePaidAmt <- queryCompound t calcDay (FeePaidAmt [fn]) + let dueAmt = fromMaybe 0 $ getValFromPerCurve pc Past Inc (succ (floor (fromRational currentBondPeriod))) + return f {F.feeDue = max 0 (dueAmt - fromRational feePaidAmt) + fd, F.feeDueDate = Just calcDay} + +disableLiqProvider :: Ast.Asset a => TestDeal a -> Date -> CE.LiqFacility -> CE.LiqFacility +disableLiqProvider _ d liq@CE.LiqFacility{CE.liqEnds = Just endDate } + | d > endDate = liq{CE.liqCredit = Just 0} + | otherwise = liq + +disableLiqProvider _ d liq@CE.LiqFacility{CE.liqEnds = Nothing } = liq + + +-- refresh available balance +---- for Replenish Support and ByPct +updateLiqProvider :: Ast.Asset a => TestDeal a -> Date -> CE.LiqFacility -> CE.LiqFacility +updateLiqProvider t d liq@CE.LiqFacility{CE.liqType = liqType, CE.liqCredit = curCredit} + = disableLiqProvider t d $ liq { CE.liqCredit = newCredit } + where + -- TODO ,need to remove due int and due fee + newCredit = case liqType of + -- CE.ReplenishSupport _ b -> max b <$> curCredit + CE.ByPct ds _r -> case (* _r) <$> (queryCompound t d (patchDateToStats d ds)) of + Left y -> Nothing -- TODO tobe fix error + Right x -> (min (fromRational x)) <$> curCredit + _ -> curCredit + +-- ^TODO : to be replace from L.accrueInt +-- Not possible to use L.accrueInt, since the interest may use formula to query on deal's stats +calcDueInt :: Ast.Asset a => TestDeal a -> Date -> L.Bond -> Either String L.Bond +calcDueInt t d b@(L.BondGroup bMap pt) + = do + m <- mapM (calcDueInt t d) bMap + return $ L.BondGroup m pt + +-- first time to accrue interest\ +-- use default date to start to accrue +calcDueInt t@TestDeal{ status = st} d b@(L.Bond _ bt oi io _ bal r dp _ di Nothing _ _ _ ) + | bal+di == 0 && (bt /= L.IO) = Right b + | otherwise = + do + sd <- getClosingDate (dates t) + b' <- calcDueInt t d (b {L.bndDueIntDate = Just sd }) -- `debug` ("hit") + return b' + +-- Interest Only Bond with Reference Balance +calcDueInt t d b@(L.Bond _ L.IO oi (L.RefBal refBal ii) _ bal r dp dInt dioi (Just lastIntDueDay) _ _ _ ) + = do + balUsed <- queryCompound t d refBal -- `debug` ("Hit acc int"++show d ++" bond name"++ L.bndName b) + let newDueInt = IR.calcInt (fromRational balUsed) lastIntDueDay d r + (fromMaybe DC_ACT_365F (L.getDayCountFromInfo ii)) -- `debug` ("Balused" ++ show (fromRational balUsed) ++ "lastIntDueDay"++show lastIntDueDay ++ "d"++show d ++ "r"++show r) + return b { L.bndDueInt = newDueInt + dInt, L.bndDueIntDate = Just d } + +-- Z bond +calcDueInt t d b@(L.Bond bn L.Z bo bi _ bond_bal bond_rate _ _ _ _ lstIntPay _ _) + = Right $ b {L.bndDueInt = 0 } + +-- Won't accrue interest for Equity bond +calcDueInt t d b@(L.Bond _ L.Equity _ _ _ _ _ _ _ _ _ _ _ _) + = Right b + +-- accrued with interest over interest +calcDueInt t d b@(L.Bond bn bt bo (L.WithIoI intInfo ioiIntInfo) _ bond_bal bond_rate _ intDue ioiIntDue (Just int_due_date) lstIntPay _ _ ) + = + let + ioiRate = case ioiIntInfo of + L.OverCurrRateBy factor -> bond_rate * fromRational (1+factor) + L.OverFixSpread spd -> bond_rate + spd + 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 } + in + do + newBondWithIntInfo <- calcDueInt t d newBond + return newBondWithIntInfo { L.bndInterestInfo = L.WithIoI intInfo ioiIntInfo} + +-- TODO: to enable override rate & balance +-- accure interest by rate +calcDueInt t d b@(L.MultiIntBond {}) + = Right $ L.accrueInt d b + +calcDueInt t d b@(L.Bond {}) + = Right $ L.accrueInt d b -- `debug` ("Hit to defualt accru"++ show (L.bndName b)) + + +-- ^ modify due principal for bond +calcDuePrin :: Ast.Asset a => TestDeal a -> Date -> L.Bond -> Either String L.Bond +calcDuePrin t d b@(L.BondGroup bMap pt) + = do + m <- sequenceA $ Map.map (calcDuePrin t d) bMap + return $ L.BondGroup m pt + +calcDuePrin t d b = + let + bondBal = L.bndBalance b + in + do + tBal <- calcBondTargetBalance t d b + return $ b {L.bndDuePrin = max 0 (bondBal - tBal) } + + +priceAssetUnion :: ACM.AssetUnion -> Date -> PricingMethod -> AP.AssetPerf -> Maybe [RateAssumption] + -> Either String PriceResult +priceAssetUnion (ACM.MO m) d pm aps mras = Ast.priceAsset m d pm aps mras Inc +priceAssetUnion (ACM.LO m) d pm aps mras = Ast.priceAsset m d pm aps mras Inc +priceAssetUnion (ACM.IL m) d pm aps mras = Ast.priceAsset m d pm aps mras Inc +priceAssetUnion (ACM.LS m) d pm aps mras = Ast.priceAsset m d pm aps mras Inc +priceAssetUnion (ACM.RE m) d pm aps mras = Ast.priceAsset m d pm aps mras Inc +priceAssetUnion (ACM.PF m) d pm aps mras = Ast.priceAsset m d pm aps mras Inc +priceAssetUnion (ACM.FA m) d pm aps mras = Ast.priceAsset m d pm aps mras Inc + +priceAssetUnionList :: [ACM.AssetUnion] -> Date -> PricingMethod -> AP.ApplyAssumptionType -> Maybe [RateAssumption] + -> Either String [PriceResult] +priceAssetUnionList assetList d pm (AP.PoolLevel assetPerf) mRates + = sequenceA [ priceAssetUnion asset d pm assetPerf mRates | asset <- assetList ] + +-- | this would used in `static` revolving ,which assumes the revolving pool will decrease +splitAssetUnion :: [Rate] -> ACM.AssetUnion -> [ACM.AssetUnion] +splitAssetUnion rs (ACM.MO m) = [ ACM.MO a | a <- Ast.splitWith m rs] +splitAssetUnion rs (ACM.LO m) = [ ACM.LO a | a <- Ast.splitWith m rs] +splitAssetUnion rs (ACM.IL m) = [ ACM.IL a | a <- Ast.splitWith m rs] +splitAssetUnion rs (ACM.LS m) = [ ACM.LS a | a <- Ast.splitWith m rs] +splitAssetUnion rs (ACM.RE m) = [ ACM.RE a | a <- Ast.splitWith m rs] +splitAssetUnion rs (ACM.FA m) = [ ACM.FA a | a <- Ast.splitWith m rs] + +-- ^ return assets bought and pool after bought +buyRevolvingPool :: Date -> Rate -> RevolvingPool -> ([ACM.AssetUnion],RevolvingPool) +buyRevolvingPool _ 0 rp = ([],rp) +buyRevolvingPool _ r rp@(StaticAsset assets) + = let + splitRatios = if r >= 1 then + [1.0,0] + else + [r,1-r] + splitedAssets = splitAssetUnion splitRatios <$> assets + assetBought = head <$> splitedAssets + assetRemains = last <$> splitedAssets + in + (assetBought ,StaticAsset assetRemains) + +buyRevolvingPool _ r rp@(ConstantAsset assets) + = let + splitedAssets = splitAssetUnion [r,0] <$> assets + assetBought = head <$> splitedAssets + in + (assetBought ,rp) + +buyRevolvingPool d r rp@(AssetCurve aus) + = let + splitRatios = if r >= 1 then + [1.0,0] + else + [r,1-r] + assets = lookupAssetAvailable rp d + splitedAssets = splitAssetUnion splitRatios <$> assets + assetBought = head <$> splitedAssets + in + (assetBought, rp) + + +data RunContext a = RunContext{ + runPoolFlow:: Map.Map PoolId CF.PoolCashflow + ,revolvingAssump:: Maybe (Map.Map String (RevolvingPool ,AP.ApplyAssumptionType)) + ,revolvingInterestRateAssump:: Maybe [RateAssumption] + } + deriving (Show) + +updateOriginDate2 :: Date -> ACM.AssetUnion -> ACM.AssetUnion +updateOriginDate2 d (ACM.LO m) = ACM.LO $ updateOriginDate m (Ast.calcAlignDate m d) +updateOriginDate2 d (ACM.MO m) = ACM.MO $ updateOriginDate m (Ast.calcAlignDate m d) +updateOriginDate2 d (ACM.IL m) = ACM.IL $ updateOriginDate m (Ast.calcAlignDate m d) +updateOriginDate2 d (ACM.LS m) = ACM.LS $ updateOriginDate m (Ast.calcAlignDate m d) +updateOriginDate2 d (ACM.RE m) = ACM.RE $ updateOriginDate m (Ast.calcAlignDate m d) + + +-- ^ get available supports in balance +evalExtraSupportBalance :: Ast.Asset a => Date -> TestDeal a -> W.ExtraSupport -> Either String Balance +evalExtraSupportBalance d t (W.WithCondition pre s) + = do + flag <- testPre d t pre + if flag then + evalExtraSupportBalance d t s + else + return 0 +evalExtraSupportBalance d t@TestDeal{accounts=accMap} (W.SupportAccount an _) + = return $ A.accBalance $ accMap Map.! an +evalExtraSupportBalance d t@TestDeal{liqProvider=Just liqMap} (W.SupportLiqFacility liqName) + = return 1e100 + -- = [ fromMaybe 1e100 (CE.liqCredit (liqMap Map.! liqName))] -- `debug` ("Returning"++ show [ fromMaybe 1e100 (CE.liqCredit (liqMap Map.! liqName))]) + -- = [ fromMaybe (fromRational (toRational infinity)) (CE.liqCredit (liqMap Map.! liqName))] -- `debug` ("Returning"++ show [ fromMaybe 1e100 (CE.liqCredit (liqMap Map.! liqName))]) +evalExtraSupportBalance d t (W.MultiSupport supports) + = sum <$> (sequenceA [ (evalExtraSupportBalance d t sp) | sp <- supports ]) + + +-- ^ draw support from a deal , return updated deal,and remaining oustanding amount +drawExtraSupport :: Date -> Amount -> W.ExtraSupport -> TestDeal a -> (TestDeal a, Amount) +-- ^ draw account support and book ledger +drawExtraSupport d amt (W.SupportAccount an (Just (dr, ln))) t@TestDeal{accounts=accMap, ledgers= Just ledgerMap} + = let + drawAmt = min (A.accBalance (accMap Map.! an)) amt + oustandingAmt = amt - drawAmt + in + (t {accounts = Map.adjust (A.draw drawAmt d Types.SupportDraw) an accMap + ,ledgers = Just $ Map.adjust (LD.entryLog drawAmt d (TxnDirection dr)) ln ledgerMap} + , oustandingAmt) + +-- ^ draw account support +drawExtraSupport d amt (W.SupportAccount an Nothing) t@TestDeal{accounts=accMap} + = let + drawAmt = min (A.accBalance (accMap Map.! an)) amt + oustandingAmt = amt - drawAmt + in + (t {accounts = Map.adjust (A.draw drawAmt d Types.SupportDraw) an accMap } + , oustandingAmt) + +-- ^ draw support from liquidity facility +drawExtraSupport d amt (W.SupportLiqFacility liqName) t@TestDeal{liqProvider= Just liqMap} + = let + theLiqProvider = liqMap Map.! liqName + drawAmt = case CE.liqCredit theLiqProvider of + Nothing -> amt -- `debug` ("From amt"++ show amt) + Just b -> min amt b -- `debug` ("From Just"++ show b++">>"++show amt) + oustandingAmt = amt - drawAmt -- `debug` ("Draw Amt"++show drawAmt++">>"++ show amt ++">>>") + in + (t {liqProvider = Just (Map.adjust (CE.draw drawAmt d) liqName liqMap)} + , oustandingAmt) + +-- ^ draw multiple supports by sequence +drawExtraSupport d amt (W.MultiSupport supports) t + = foldr + (\support (deal,remainAmt) -> drawExtraSupport d remainAmt support deal) + (t, amt) + supports + +inspectListVars :: Ast.Asset a => TestDeal a -> Date -> [DealStats] -> Either String [ResultComponent] +inspectListVars t d dss = sequenceA [ inspectVars t d ds | ds <- dss] + +inspectVars :: Ast.Asset a => TestDeal a -> Date -> DealStats -> Either String ResultComponent +inspectVars t d ds = + case getDealStatType ds of + RtnRate -> do + q <- queryCompound t d (patchDateToStats d ds) + return $ InspectRate d ds $ fromRational q + RtnBool -> do + q <- queryDealBool t (patchDateToStats d ds) d + return $ InspectBool d ds q + RtnInt -> do + q <- queryCompound t d (patchDateToStats d ds) + return $ InspectInt d ds $ round . fromRational $ q + _ -> do + q <- queryCompound t d (patchDateToStats d ds) + return $ InspectBal d ds $ fromRational q + +showInspection :: ResultComponent -> String +showInspection (InspectRate d ds r) = show r +showInspection (InspectBool d ds r) = show r +showInspection (InspectInt d ds r) = show r +showInspection (InspectBal d ds r) = show r +showInspection x = error $ "not implemented for showing ResultComponent " ++ show x + + +calcAvailFund :: Ast.Asset a => TestDeal a -> Date -> A.Account -> Maybe W.ExtraSupport -> Either String Balance +calcAvailFund t d acc Nothing = Right $ A.accBalance acc +calcAvailFund t d acc (Just support) = ((A.accBalance acc) +) <$> evalExtraSupportBalance d t support + +-- ^ Deal, Date , cap balance, due balance +applyLimit :: Ast.Asset a => TestDeal a -> Date -> Balance -> Balance -> Maybe Limit -> Either String Balance +applyLimit t d availBal dueBal Nothing = Right $ min availBal dueBal +applyLimit t d availBal dueBal (Just limit) = + (min dueBal) <$> + case limit of + DueCapAmt amt -> Right $ min amt availBal + DS ds -> do + v <- queryCompound t d (patchDateToStats d ds) + return (min (fromRational v) availBal) + DuePct pct -> Right $ min availBal $ mulBR dueBal pct + + x -> Left $ "Date:"++show d ++" Unsupported limit found:"++ show x + +calcAvailAfterLimit :: Ast.Asset a => TestDeal a -> Date -> A.Account -> Maybe W.ExtraSupport + -> Balance -> (Maybe Limit) -> Either String Balance +calcAvailAfterLimit t d acc mSupport dueAmt mLimit + = let + availFund = case mSupport of + Nothing -> Right $ A.accBalance acc + Just support -> ((A.accBalance acc) +) <$> evalExtraSupportBalance d t support + in + do + r <- (min dueAmt) <$> + case mLimit of + Nothing -> availFund + Just (DueCapAmt amt) -> min amt <$> availFund + Just (DS ds) -> liftA2 min (fromRational <$> (queryCompound t d (patchDateToStats d ds))) availFund + Just (DuePct pct) -> min (mulBR dueAmt pct) <$> availFund + _ -> Left ("Failed to find type"++ show mLimit) + if r < 0 then + (Left ("Negative value when calculates Limit:"++ show mLimit++ "but got from availFund"++ show availFund)) + else + return r + + +updateSupport :: Ast.Asset a => Date -> Maybe W.ExtraSupport -> Balance -> TestDeal a -> TestDeal a +updateSupport _ Nothing _ t = t +updateSupport d (Just support) bal t = fst $ drawExtraSupport d bal support t + +performActionWrap :: Ast.Asset a => Date -> (TestDeal a, RunContext a, DL.DList ResultComponent) + -> W.Action -> Either String (TestDeal a, RunContext a, DL.DList ResultComponent) + +performActionWrap d (t, rc, logs) (W.BuyAsset ml pricingMethod accName pId) + = performActionWrap d (t, rc, logs) (W.BuyAssetFrom ml pricingMethod accName (Just "Consol") pId) + +performActionWrap d + (t@TestDeal{ accounts = accsMap , pool = pt} + ,rc@RunContext{runPoolFlow=pFlowMap + ,revolvingAssump=Just rMap + ,revolvingInterestRateAssump = mRates} + ,logs) + (W.BuyAssetFrom ml pricingMethod accName mRevolvingPoolName pId) + = + let + revolvingPoolName = fromMaybe "Consol" mRevolvingPoolName + (assetForSale::RevolvingPool, perfAssumps::AP.ApplyAssumptionType) = rMap Map.! revolvingPoolName -- `debug` ("Getting pool"++ revolvingPoolName) + + _assets = lookupAssetAvailable assetForSale d + assets = updateOriginDate2 d <$> _assets -- `debug` ("Asset on revolv"++ show _assets) + + accBal = A.accBalance $ accsMap Map.! accName + pIdToChange = fromMaybe PoolConsol pId --`debug` ("purchase date"++ show d++ "\n" ++ show assetBought) + in + do + limitAmt <- case ml of + Just (DS ds) -> queryCompound t d (patchDateToStats d ds) + Just (DueCapAmt amt) -> Right (toRational amt) + Just (DuePct pct) -> Right $ toRational (mulBR accBal pct) + Nothing -> Right (toRational accBal) + let availBal = min (fromRational limitAmt) accBal -- `debug` ("Date"++ show d ++" Value on r -asset "++ show valuationOnAvailableAssets) + valOnAvailableAssets <- priceAssetUnionList assets d pricingMethod perfAssumps mRates + let valuationOnAvailableAssets = sum $ getPriceValue <$> valOnAvailableAssets + let purchaseAmt = case assetForSale of + (StaticAsset _) -> min availBal valuationOnAvailableAssets -- `debug` ("Valuation on rpool"++show valuationOnAvailableAssets) + ConstantAsset _ -> availBal + AssetCurve _ -> min availBal valuationOnAvailableAssets + let purchaseRatio = divideBB purchaseAmt valuationOnAvailableAssets -- `debug` ("In Buy >>> Date"++ show d ++ " Purchase Amt"++show purchaseAmt++">> avail value on availAsset"++ show valuationOnAvailableAssets ) + let (assetBought,poolAfterBought) = buyRevolvingPool d (toRational purchaseRatio) assetForSale -- `debug` ("In Buy >>> date "++ show d ++ "purchase ratio"++ show purchaseRatio) + let boughtAssetBal = sum $ curBal <$> assetBought -- `debug` ("In Buy >>> Asset bought 0 \n"++ show assetBought++ "pflow map\n"++ show pFlowMap++" p id to change\n"++ show pIdToChange) + -- update runtime balance + let newPt = case pt of + MultiPool pm -> MultiPool $ Map.adjust + (over P.poolIssuanceStat (Map.adjust (+ boughtAssetBal) RuntimeCurrentPoolBalance)) + pIdToChange + pm + 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) + (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 + 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 + lastOdate = last oDs + lastBdate = last bDs + in + if lastOdate > lastBdate then + [] + else + sliceDates (SliceAfter lastOdate) bDs + + mergedCf = CF.mergePoolCf2 cfOrigin cfBought + in + ((over CF.cashflowTxn (`CF.aggTsByDates` (dsInterval ++ newAggDates)) mergedCf), (++ [cfBought]) <$> mAflow) + ) + pIdToChange + 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)} + return (t { accounts = newAccMap , pool = newPt}, newRc, logs) + +performActionWrap d + (t + ,rc@RunContext{runPoolFlow=pcf + ,revolvingAssump=Nothing + ,revolvingInterestRateAssump=mRates} + ,logs) + (W.BuyAsset ml pricingMethod accName _) + = Left $ "Date:"++ show d ++"Missing revolving Assumption(asset assumption & asset to buy)" ++ name t + +performActionWrap d + (t + ,rc@RunContext{runPoolFlow=pcf + ,revolvingAssump=Nothing + ,revolvingInterestRateAssump=mRates} + ,logs) + (W.BuyAssetFrom _ _ _ _ _) + = Left $ "Date:"++ show d ++"Missing revolving Assumption(asset assumption & asset to buy)" ++ name t +-- TODO need to set a limit to sell +performActionWrap d + (t@TestDeal{accounts = accMap, pool = pt} + ,rc@RunContext{runPoolFlow = pcf} + ,logs) + (W.LiquidatePool lm an mPid) + = let + liqFunction = \(p@P.Pool{ P.issuanceStat = m} ) + -> 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 + (MultiPool pm, Nothing) -> pm + (MultiPool pm,Just pids) -> let + selectedPids = S.fromList pids + in + Map.filterWithKey (\k v -> S.member k selectedPids) pm + + (ResecDeal _,_) -> error "Not implement on liquidate resec deal" + + + + liqAmtByPool = Map.mapWithKey (\k p -> P.pricingPoolFlow d p (pcf Map.! k) lm) poolMapToLiq -- `debug` ("pool id to liq"++ show poolMapToLiq) + liqAmt = sum $ Map.elems liqAmtByPool + + -- Update collected cashflow + newPt = case (pt, mPid) of + (MultiPool pm, Nothing) -> MultiPool $ Map.map liqFunction pm + (MultiPool pm, Just pids) -> let + selectedPids = S.fromList pids + selectedPoolMap = Map.filterWithKey (\k v -> S.member k selectedPids) pm + in + MultiPool $ Map.union (Map.map liqFunction selectedPoolMap) pm + (ResecDeal _,_) -> error "Not implement on liquidate resec deal" + + liqComment = LiquidationProceeds (fromMaybe [] mPid) + accMapAfterLiq = Map.adjust (A.deposit liqAmt d liqComment) an accMap + -- REMOVE future cf + 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) + + +performActionWrap d (t, rc, logs) (W.WatchVal ms dss) + = (inspectListVars t d dss) >>= (\vs -> Right (t, rc, DL.snoc logs (InspectWaterfall d ms dss (showInspection <$> vs)))) + + +performActionWrap d (t, rc, logs) (W.ActionWithPre p actions) + = do + flag <- testPre d t p + if flag then + foldM (performActionWrap d) (t,rc,logs) actions + else + return (t, rc, logs) + + +performActionWrap d (t, rc, logs) (W.ActionWithPre2 p actionsTrue actionsFalse) + = do + flag <- testPre d t p + if flag then + foldM (performActionWrap d) (t,rc,logs) actionsTrue + else + foldM (performActionWrap d) (t,rc,logs) actionsFalse + + +performActionWrap d (t, rc, logs) (W.ChangeStatus mPre newSt) + = case mPre of + Nothing -> return (t {status=newSt} , rc, logs) + Just p -> + do + flag <- testPre d t p + if flag then + return (t {status=newSt} , rc, logs) + else + return (t, rc, logs) + +-- ^ go down to performAction +performActionWrap d (t, rc, logs) a + = do + dealAfterExe <- performAction d t a + return (dealAfterExe, rc, logs) + +performAction :: Ast.Asset a => Date -> TestDeal a -> W.Action -> Either String (TestDeal a) +performAction d t@TestDeal{accounts=accMap, ledgers = Just ledgerM} + (W.TransferAndBook mLimit an1 an2 (dr, lName) mComment) + = let + sourceAcc = accMap Map.! an1 + targetAcc = accMap Map.! an2 + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an1) Nothing (A.accBalance sourceAcc) mLimit + in + do + transferAmt <- actualPaidOut + let accMapAfterDraw = Map.adjust (A.draw transferAmt d (TxnComments [Transfer an1 an2,(BookLedgerBy dr lName)])) an1 accMap -- `debug` (">>PDL >>Ledger bal"++show d ++ show targetAmt) + let accMapAfterDeposit = Map.adjust (A.deposit transferAmt d (TxnComments [Transfer an1 an2,(BookLedgerBy dr lName)])) an2 accMapAfterDraw + let newLedgerM = Map.adjust (LD.entryLog transferAmt d (TxnDirection dr)) lName ledgerM + return t {accounts = accMapAfterDeposit, ledgers = Just newLedgerM} + +performAction d t@TestDeal{accounts=accMap} (W.Transfer mLimit an1 an2 mComment) + = let + sourceAcc = accMap Map.! an1 + targetAcc = accMap Map.! an2 + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an1) Nothing (A.accBalance sourceAcc) mLimit + in + do + transferAmt <- actualPaidOut + let accMapAfterDraw = Map.adjust (A.draw transferAmt d (Transfer an1 an2)) an1 accMap -- `debug` (">>PDL >>Ledger bal"++show d ++ show targetAmt) + let accMapAfterDeposit = Map.adjust (A.deposit transferAmt d (Transfer an1 an2)) an2 accMapAfterDraw + return t {accounts = accMapAfterDeposit} + +performAction d t@TestDeal{accounts=accMap} (W.TransferMultiple sourceAccList targetAcc mComment) + = foldM (\acc (mLimit, sourceAccName) -> + performAction d acc (W.Transfer mLimit sourceAccName targetAcc mComment)) + t + sourceAccList + +-- ^ book ledger +performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.Till ledger dr ds)) = + do + targetAmt <- queryCompound t d ds + let (bookDirection, amtToBook) = LD.bookToTarget (ledgerM Map.! ledger) (dr, fromRational targetAmt) + let newLedgerM = Map.adjust (LD.entryLogByDr bookDirection amtToBook d Nothing) ledger ledgerM + return $ t {ledgers = Just newLedgerM } + +performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.ByDS ledger dr ds)) = + do + amtToBook <- queryCompound t d ds + let newLedgerM = Map.adjust (LD.entryLogByDr dr (fromRational amtToBook) d Nothing) ledger ledgerM + return $ t {ledgers = Just newLedgerM } + +-- ^ it will book ledgers by order with mandatory caps which describes by a +-- ^ ds -> value to book +-- ^ ledgersList -> list of ledgers to book +performAction d t@TestDeal{ledgers= Just ledgerM} (W.BookBy (W.PDL dr ds ledgersList)) = + let + ledgerCaps = sequenceA [ queryCompound t d ledgerCap | ledgerCap <- snd <$> ledgersList ] + ledgerNames = fst <$> ledgersList + in + do + amtToBook <- queryCompound t d ds + ledgCaps <- ledgerCaps + let amtBookedToLedgers = paySeqLiabilitiesAmt (fromRational amtToBook) (fromRational <$> ledgCaps) --`debug` ("amt to book"++ show amtToBook) + let newLedgerM = foldr + (\(ln,amt) acc -> Map.adjust (LD.entryLogByDr dr amt d Nothing) ln acc) + ledgerM + (zip ledgerNames amtBookedToLedgers) --`debug` ("amts to book"++ show amtBookedToLedgers) + return $ t {ledgers = Just newLedgerM} + +-- ^ pay fee sequentially, but not accrued +performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFeeBySeq mLimit an fns mSupport) = + let + availAccBal = A.accBalance (accMap Map.! an) + feesToPay = map (feeMap Map.!) fns + totalFeeDue = sum $ map F.feeDue feesToPay + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalFeeDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (feesPaid, remainAmt) = paySequentially d paidOutAmt F.feeDue (F.payFee d) [] feesToPay + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap + ,fees = Map.fromList (zip fns feesPaid) <> feeMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + +-- ^ pay out fee in pro-rata fashion +performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFee mLimit an fns mSupport) = + let + availAccBal = A.accBalance (accMap Map.! an) + feesToPay = map (feeMap Map.!) fns + totalFeeDue = sum $ map F.feeDue feesToPay + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalFeeDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (feesPaid, remainAmt) = payProRata d paidOutAmt F.feeDue (F.payFee d) feesToPay + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap + ,fees = Map.fromList (zip fns feesPaid) <> feeMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + + +performAction d t (W.AccrueAndPayIntBySeq mLimit an bnds mSupport) + = do + dealWithBondDue <- performAction d t (W.CalcBondInt bnds) + performAction d dealWithBondDue (W.PayIntBySeq mLimit an bnds mSupport) + +performAction d t@TestDeal{bonds=bndMap, accounts=accMap, liqProvider=liqMap} + (W.PayIntOverIntBySeq mLimit an bnds mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = (Map.!) bndMap <$> bnds + dueAmts = L.getDueIntOverInt <$> bndsList + totalDue = sum dueAmts + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.getDueIntOverInt (L.payInt d) [] bndsList + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap + ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + + +performAction d t@TestDeal{bonds=bndMap, accounts=accMap, liqProvider=liqMap} + (W.PayIntBySeq mLimit an bnds mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = (Map.!) bndMap <$> bnds + dueAmts = L.getTotalDueInt <$> bndsList + totalDue = sum dueAmts + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.getTotalDueInt (L.payInt d) [] bndsList + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap + ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} + (W.PayIntOverInt mLimit an bnds mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = (Map.!) bndMap <$> bnds + dueAmts = L.getDueIntOverInt <$> bndsList + totalDue = sum dueAmts + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.getDueIntOverInt (L.payInt d) bndsList + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap + ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} + (W.PayInt mLimit an bnds mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = (Map.!) bndMap <$> bnds + dueAmts = L.getTotalDueInt <$> bndsList + totalDue = sum dueAmts + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.getTotalDueInt (L.payInt d) bndsList + let accPaidOut = (min availAccBal paidOutAmt) + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap + ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap,ledgers= Just ledgerM} + (W.PayIntAndBook mLimit an bnds mSupport (dr, lName)) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = (Map.!) bndMap <$> bnds + dueAmts = L.getTotalDueInt <$> bndsList + totalDue = sum dueAmts + actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + in + do + paidOutAmt <- actualPaidOut + let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.getTotalDueInt (L.payInt d) bndsList + let accPaidOut = min availAccBal paidOutAmt + let newLedgerM = Map.adjust (LD.entryLogByDr dr paidOutAmt d Nothing) lName ledgerM + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap + ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap + ,ledgers = Just newLedgerM} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + + + +performAction d t (W.AccrueAndPayInt mLimit an bnds mSupport) = + do + dealWithBondDue <- performAction d t (W.CalcBondInt bnds) + performAction d dealWithBondDue (W.PayInt mLimit an bnds mSupport) + +performAction d t (W.CalcAndPayFee mLimit ans fees mSupport) = + do + dealWithFeeDue <- performAction d t (W.CalcFee fees) + performAction d dealWithFeeDue (W.PayFee mLimit ans fees mSupport) + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntResidual mLimit an bndName) = + let + availBal = A.accBalance $ accMap Map.! an + in + do + limitAmt <- applyLimit t d availBal availBal mLimit + return $ t {accounts = Map.adjust (A.draw limitAmt d (PayYield bndName)) an accMap + , bonds = Map.adjust (L.payYield d limitAmt) bndName bndMap} + + +-- TODO check for multi interest bond +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntByRateIndex mLimit an bndNames idx mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = filter (is L._MultiIntBond) $ (Map.!) bndMap <$> bndNames + bndNames_ = L.bndName <$> bndsList + in + do + totalDue <- queryCompound t d (CurrentDueBondIntTotalAt idx bndNames_) + actualPaidOut <- calcAvailAfterLimit t d (accMap Map.! an) mSupport (fromRational totalDue) mLimit -- `debug` ("Date "++ show d ++" total due"++show (fromRational totalDue)) + let (paidBonds, _) = payProRata d actualPaidOut (`L.getTotalDueIntAt` idx) (L.payIntByIndex d idx) bndsList -- `debug` ("Date"++show d++" paid out amt"++show (L.bndDueInts (paidBonds!!0))) + let accMap1 = accMap -- `debug` ("Date"++show d++" paid out amt"++show (L.bndDueInts (paidBonds!!0))) + return $ t {accounts = Map.adjust (A.draw actualPaidOut d (PayInt bndNames_)) an accMap1 + , bonds = Map.fromList (zip bndNames_ paidBonds) <> bndMap} + + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntByRateIndexBySeq mLimit an bndNames idx mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = filter (is L._MultiIntBond) $ (Map.!) bndMap <$> bndNames + bndNames_ = L.bndName <$> bndsList + in + do + totalDue <- queryCompound t d (CurrentDueBondIntAt idx bndNames_) + actualPaidOut <- calcAvailAfterLimit t d (accMap Map.! an) mSupport (fromRational totalDue) mLimit + let (paidBonds, _) = paySequentially d actualPaidOut (`L.getTotalDueIntAt` idx) (L.payIntByIndex d idx) [] bndsList + return $ t {accounts = Map.adjust (A.draw actualPaidOut d (PayInt bndNames_)) an accMap + , bonds = Map.fromList (zip bndNames_ paidBonds) <> bndMap} + + +performAction d t@TestDeal{fees=feeMap,accounts=accMap} (W.PayFeeResidual mlimit an feeName) = + let + availBal = A.accBalance $ accMap Map.! an + in + do + paidOutAmt <- applyLimit t d availBal availBal mlimit + let accMapAfterPay = Map.adjust (A.draw paidOutAmt d (PayFeeYield feeName)) an accMap + let feeMapAfterPay = Map.adjust (F.payResidualFee d paidOutAmt) feeName feeMap + return $ t {accounts = accMapAfterPay, fees = feeMapAfterPay} + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} + (W.PayPrinBySeq mLimit an bnds mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsList = (Map.!) bndMap <$> bnds + bndsToPay = filter (not . L.isPaidOff) bndsList + bndsToPayNames = L.bndName <$> bndsToPay + in + do + bndsWithDue <- sequenceA $ calcDuePrin t d <$> bndsToPay + let bndsDueAmts = L.bndDuePrin <$> bndsWithDue + let totalDue = sum bndsDueAmts -- `debug` ("Date"++show d++" due amt"++show bndsDueAmts) + let actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + paidOutAmt <- actualPaidOut -- `debug` ("Date"++show d++" paid out amt"++show actualPaidOut) + let (bondsPaid, remainAmt) = paySequentially d paidOutAmt L.bndDuePrin (L.payPrin d) [] bndsWithDue + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayPrin bndsToPayNames)) an accMap + ,bonds = Map.fromList (zip bndsToPayNames bondsPaid) <> bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} + (W.PayPrinGroup mLimit an bndGrpName by mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bg@(L.BondGroup bndsMap pt) = bndMap Map.! bndGrpName + bndsToPay = Map.filter (not . L.isPaidOff) bndsMap + bndsToPayNames = L.bndName <$> Map.elems bndsToPay + in + do + bndsWithDueMap <- sequenceA $ Map.map (calcDuePrin t d) bndsToPay + bgGap <- queryCompound t d (BondBalanceGapAt d bndGrpName) + let bndsDueAmtsMap = Map.map (\x -> (x, L.bndDuePrin x)) bndsWithDueMap + let actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport (fromRational bgGap) mLimit + paidOutAmt <- actualPaidOut + + let payOutPlan = allocAmtToBonds by paidOutAmt (Map.elems bndsDueAmtsMap) -- `debug` (">date"++ show payAmount) + let payOutPlanWithBondName = [ (L.bndName bnd,amt) | (bnd,amt) <- payOutPlan] -- `debug` (">date"++show d++"payOutPlan"++ show payOutPlan) + + let bndMapAfterPay = foldr + (\(bndName, _amt) acc -> Map.adjust (L.payPrin d _amt) bndName acc) + bndsMap + payOutPlanWithBondName -- `debug` (">date"++show d++"payoutPlan"++ show payOutPlanWithBondName) + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayGroupPrin bndsToPayNames)) an accMap + ,bonds = Map.insert bndGrpName (L.BondGroup bndMapAfterPay pt) bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + + +-- ^ accure interest and payout interest to a bond group with sequence input "by" +performAction d t@TestDeal{bonds=bndMap} (W.AccrueAndPayIntGroup mLimit an bndName by mSupport) + = do + dAfterAcc <- performAction d t (W.AccrueIntGroup [bndName])-- `debug` ("Acc due int grp"++ show (getDueInt (bndMap Map.! bndName))) + performAction d dAfterAcc (W.PayIntGroup mLimit an bndName by mSupport) + +-- ^ accrue interest for a group of bonds +performAction d t@TestDeal{bonds=bndMap} (W.AccrueIntGroup bndNames) + = do + let bondGrp = Map.filterWithKey (\k _ -> S.member k (S.fromList bndNames)) bndMap + bondGrpAccrued <- mapM (calcDueInt t d) bondGrp + return t {bonds = bondGrpAccrued <> bndMap} + +-- ^ pay interest for a group of bonds with sequence input "by" +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayIntGroup mLimit an bndGrpName by mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + L.BondGroup bndsMap pt = bndMap Map.! bndGrpName + bndsToPay = Map.filter (not . L.isPaidOff) bndsMap + bndsToPayNames = L.bndName <$> Map.elems bndsToPay + in + do + bndsWithDueMap <- mapM (calcDueInt t d) bndsToPay + let bndsDueAmtsMap = Map.map (\x -> (x, L.getTotalDueInt x)) bndsWithDueMap + let totalDue = sum $ snd <$> Map.elems bndsDueAmtsMap -- `debug` (">date"++show d++" due amt"++show bndsDueAmtsMap) + let actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + paidOutAmt <- actualPaidOut + + let payOutPlan = allocAmtToBonds by paidOutAmt (Map.elems bndsDueAmtsMap) -- `debug` (">date"++ show payAmount) + let payOutPlanWithBondName = [ (L.bndName bnd,amt) | (bnd,amt) <- payOutPlan] -- `debug` (">date"++show d++"payOutPlan"++ show payOutPlan) + + let bndMapAfterPay = foldr + (\(bndName, _amt) acc -> Map.adjust (L.payInt d _amt) bndName acc) + bndsMap + payOutPlanWithBondName -- `debug` (">date"++show d++"payoutPlan"++ show payOutPlanWithBondName) + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayGroupInt bndsToPayNames)) an accMap + ,bonds = Map.insert bndGrpName (L.BondGroup bndMapAfterPay pt) bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayPrinWithDue an bnds Nothing) + = Right $ t {accounts = accMapAfterPay, bonds = bndMapUpdated} + where + acc = accMap Map.! an + availBal = A.accBalance acc + bndsToPay = getActiveBonds t bnds + bndsToPayNames = L.bndName <$> bndsToPay + bndsDueAmts = L.bndDuePrin <$> bndsToPay + actualPaidOut = min availBal $ sum bndsDueAmts + + (bndsPaid, remainAmt) = payProRata d actualPaidOut L.bndDuePrin (L.payPrin d) bndsToPay + + bndMapUpdated = (Map.fromList $ zip bndsToPayNames bndsPaid) <> bndMap + accMapAfterPay = Map.adjust (A.draw actualPaidOut d (PayPrin bnds)) an accMap + + +performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayPrin mLimit an bnds mSupport) + = let + availAccBal = A.accBalance (accMap Map.! an) + bndsToPay = getActiveBonds t bnds + in + do + bndsWithDue <- sequenceA $ calcDuePrin t d <$> bndsToPay + let bndsDueAmts = L.bndDuePrin <$> bndsWithDue + let bndsToPayNames = L.bndName <$> bndsWithDue + let totalDue = sum bndsDueAmts + let actualPaidOut = calcAvailAfterLimit t d (accMap Map.! an) mSupport totalDue mLimit + paidOutAmt <- actualPaidOut + let (bondsPaid, remainAmt) = payProRata d paidOutAmt L.bndDuePrin (L.payPrin d) bndsWithDue + let accPaidOut = min availAccBal paidOutAmt + + let dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (PayPrin bndsToPayNames)) an accMap + ,bonds = Map.fromList (zip bndsToPayNames bondsPaid) <> bndMap} + + let supportPaidOut = paidOutAmt - accPaidOut + return $ updateSupport d mSupport supportPaidOut dealAfterAcc + +-- ^ pay principal without any limit +performAction d t@TestDeal{accounts=accMap, bonds=bndMap} (W.PayPrinResidual an bnds) = + Right $ t {accounts = accMapAfterPay, bonds = bndMapUpdated} -- `debug` ("Bond Prin Pay Result"++show(bndMapUpdated)) + where + acc = accMap Map.! an + + bndsToPay = getActiveBonds t bnds + bndsToPayNames = L.bndName <$> bndsToPay + availBal = A.accBalance acc + bndsDueAmts = map L.getCurBalance bndsToPay + + actualPaidOut = min availBal $ sum bndsDueAmts -- `debug` ("bonds totoal due ->"++show(bndsDueAmts)) + bndsAmountToBePaid = zip bndsToPay (prorataFactors bndsDueAmts actualPaidOut) + bndsPaid = map (\(l,amt) -> L.payPrin d amt l) bndsAmountToBePaid -- `debug` ("pay bonds "++show bnds ++"pay prin->>>To"++show(prorataFactors bndsDueAmts availBal)) + + bndMapUpdated = (Map.fromList $ zip bndsToPayNames bndsPaid) <> bndMap + accMapAfterPay = Map.adjust (A.draw actualPaidOut d (PayPrin bnds)) an accMap + +performAction d t@TestDeal{accounts=accMap, bonds=bndMap} (W.FundWith mlimit an bnd) = + do + fundAmt_ <- case mlimit of + Just (DS ds) -> queryCompound t d (patchDateToStats d ds) + Just (DueCapAmt amt) -> Right $ toRational amt + _ -> Left $ "Date:"++show d ++"Not valid limit for funding with bond"++ show bnd + let fundAmt = fromRational fundAmt_ + let accMapAfterFund = Map.adjust (A.deposit fundAmt d (FundWith bnd fundAmt)) an accMap + let bndFunded = L.fundWith d fundAmt $ bndMap Map.! bnd + return $ t {accounts = accMapAfterFund, bonds= Map.fromList [(bnd,bndFunded)] <> bndMap } + +-- ^ write off bonds and book +performAction d t@TestDeal{bonds = bndMap, ledgers = Just ledgerM } + (W.WriteOffAndBook mLimit bnd (dr,lName)) + = let + bndToWriteOff = bndMap Map.! bnd + bndBal = L.bndBalance bndToWriteOff + in + do + writeAmt <- applyLimit t d bndBal bndBal mLimit + let newLedgerM = Map.adjust (LD.entryLogByDr dr writeAmt d (Just (WriteOff bnd writeAmt))) lName ledgerM + bndWritedOff <- L.writeOff d writeAmt bndToWriteOff + return $ t {bonds = Map.fromList [(bnd,bndWritedOff)] <> bndMap, ledgers = Just newLedgerM} + +performAction d t@TestDeal{bonds=bndMap} (W.WriteOff mlimit bnd) + = do + writeAmt <- case mlimit of + Just (DS ds) -> queryCompound t d (patchDateToStats d ds) + Just (DueCapAmt amt) -> Right $ toRational amt + Nothing -> Right $ toRational . L.bndBalance $ bndMap Map.! bnd + x -> Left $ "Date:"++show d ++"not supported type to determine the amount to write off"++ show x + + let writeAmtCapped = min (fromRational writeAmt) $ L.bndBalance $ bndMap Map.! bnd + bndWritedOff <- L.writeOff d writeAmtCapped $ bndMap Map.! bnd + return $ t {bonds = Map.fromList [(bnd,bndWritedOff)] <> bndMap} + +performAction d t@TestDeal{bonds=bndMap, ledgers = Just ledgerM} + (W.WriteOffBySeqAndBook mLimit bnds (dr,lName)) + = do + bndsToWriteOff <- mapM (calcDueInt t d . (bndMap Map.!)) bnds + let totalBondBal = sum $ L.bndBalance <$> bndsToWriteOff + -- total amount to be write off + writeAmt <- applyLimit t d totalBondBal totalBondBal mLimit + (bndWrited, _) <- paySeqM d writeAmt L.bndBalance (L.writeOff d) (Right []) bndsToWriteOff + let bndMapUpdated = lstToMapByFn L.bndName bndWrited + let newLedgerM = Map.adjust (LD.entryLogByDr dr writeAmt d Nothing) lName ledgerM + return t {bonds = bndMapUpdated <> bndMap, ledgers = Just newLedgerM} + + +performAction d t@TestDeal{bonds=bndMap } (W.WriteOffBySeq mLimit bnds) + = do + bondsToWriteOff <- mapM (calcDueInt t d . (bndMap Map.!)) bnds + let totalBondBal = sum $ L.bndBalance <$> bondsToWriteOff + writeAmt <- applyLimit t d totalBondBal totalBondBal mLimit + (bndWrited, _) <- paySeqM d writeAmt L.bndBalance (L.writeOff d) (Right []) bondsToWriteOff + let bndMapUpdated = lstToMapByFn L.bndName bndWrited + return t {bonds = bndMapUpdated <> bndMap } + +performAction d t@TestDeal{fees=feeMap} (W.CalcFee fns) + = do + newFeeMap <- mapM (calcDueFee t d) $ getFeeByName t (Just fns) + return t {fees = newFeeMap <> feeMap } + +-- performAction d t@TestDeal{bonds=bndMap} (W.CalcBondIntBy bn dsBal dsRate) +-- = let +-- mBnd = case getBondByName t bn of +-- Just b -> Right b +-- Nothing -> Left $ "Cant find bond in deal"++ show bn +-- in +-- do +-- bal <- queryCompound t d (patchDateToStats d dsBal) +-- rate <- queryCompound t d (patchDateToStats d dsRate) +-- bnd <- mBnd +-- let dc = DC_ACT_365F +-- let dueInt = L.calcDueInt bnd bal rate dc +-- newBondMap <- mapM (calcDueInt t d mBalDs mRateDs) $ getBondsByName t (Just bns) +-- +-- return t {bonds = newBondMap <> bndMap} + +performAction d t@TestDeal{bonds=bndMap} (W.CalcBondInt bns) + = do + newBondMap <- mapM (calcDueInt t d) $ getBondsByName t (Just bns) + return t {bonds = newBondMap <> bndMap} + +-- ^ set due prin mannually +performAction d t@TestDeal{bonds=bndMap} (W.CalcBondPrin2 mLimit bnds) + = let + bndsToPay = filter (not . L.isPaidOff) $ map (bndMap Map.!) bnds + bndsToPayNames = L.bndName <$> bndsToPay + in + do + bndsDueAmts <- sequenceA $ (L.bndDuePrin <$>) <$> (calcDuePrin t d) <$> bndsToPay + let totalDue = sum bndsDueAmts + bookCap <- applyLimit t d totalDue totalDue mLimit + let bndsAmountToBook = zip bndsToPayNames $ prorataFactors bndsDueAmts bookCap + let newBndMap = foldr + (\(bn,amt) acc -> Map.adjust (\b -> b {L.bndDuePrin = amt}) bn acc) + bndMap + bndsAmountToBook -- `debug` ("Calc Bond Prin"++ show bndsAmountToBePaid) + + return $ t {bonds = newBndMap} -- `debug` ("New map after calc due"++ show (Map.mapWithKey (\k v -> (k, L.bndDuePrin v)) newBndMap)) + +performAction d t@TestDeal{bonds=bndMap, accounts = accMap} (W.CalcBondPrin mLimit accName bnds mSupport) + = let + accBal = A.accBalance $ accMap Map.! accName + bndsToPay = filter (not . L.isPaidOff) $ map (bndMap Map.!) bnds + bndsToPayNames = L.bndName <$> bndsToPay + in + do + bndsDueAmts <- sequenceA $ (L.bndDuePrin <$>) <$> (calcDuePrin t d) <$> bndsToPay + availBal <- calcAvailFund t d (accMap Map.! accName) mSupport + limitCap <- applyLimit t d availBal (sum bndsDueAmts) mLimit + let payAmount = min limitCap availBal + let bndsAmountToBePaid = zip bndsToPayNames $ prorataFactors bndsDueAmts payAmount -- (bond, amt-allocated) + let newBndMap = foldr + (\(bn,amt) acc -> Map.adjust (\b -> b {L.bndDuePrin = amt}) bn acc) + bndMap + bndsAmountToBePaid -- `debug` ("Calc Bond Prin"++ show bndsAmountToBePaid) + return $ t {bonds = newBndMap} + + +-- ^ draw cash and deposit to account +performAction d t@TestDeal{accounts=accs, liqProvider = Just _liqProvider} (W.LiqSupport mLimit pName CE.LiqToAcc ans) + | length ans == 1 + = let + liq = _liqProvider Map.! pName + [an] = ans + in + do + transferAmt <- case (CE.liqCredit liq, mLimit) of + (Nothing, Nothing) -> Left $ "Date:"++show d ++"Can't deposit unlimit cash to an account in LiqSupport(Account):"++ show pName ++ ":"++ show an + (Just av, Nothing) -> Right . toRational $ av + (Nothing, Just (DS ds)) -> queryCompound t d (patchDateToStats d ds) -- `debug` ("hit with ds"++ show ds) + (Just av, Just (DS ds)) -> (min (toRational av)) <$> queryCompound t d (patchDateToStats d ds) + (_ , Just _x) -> Left $ "Date:"++show d ++"Not support limit in LiqSupport(Account)"++ show _x + let dAmt = fromRational transferAmt + return t { accounts = Map.adjust (A.deposit dAmt d (LiquidationSupport pName)) an accs + , liqProvider = Just $ Map.adjust (CE.draw dAmt d) pName _liqProvider } + | otherwise = Left $ "Date:"++show d ++"There should only one account for LiqToAcc of LiqSupport" + + +-- TODO : add pay fee by sequence +performAction d t@TestDeal{fees=feeMap,liqProvider = Just _liqProvider} (W.LiqSupport mLimit pName CE.LiqToFee fns) + = let + liq = _liqProvider Map.! pName + in + do + totalDueFee <- queryCompound t d (CurrentDueFee fns) + supportAmt <- applyLimit t d (fromRational totalDueFee) (fromRational totalDueFee) mLimit + + let transferAmt = case CE.liqCredit liq of + Nothing -> supportAmt + (Just v) -> min supportAmt v + + let newFeeMap = payInMap d transferAmt F.feeDue (F.payFee d) fns ByProRata feeMap + let newLiqMap = Map.adjust (CE.draw transferAmt d) pName _liqProvider + return $ t { fees = newFeeMap, liqProvider = Just newLiqMap } + +-- TODO : add pay int by sequence +-- TODO : may not work for bond group +performAction d t@TestDeal{bonds=bndMap,liqProvider = Just _liqProvider} + (W.LiqSupport mLimit pName CE.LiqToBondInt bns) + = let + liq = _liqProvider Map.! pName + in + do + totalDueInt <- queryCompound t d (CurrentDueBondInt bns) + supportAmt <- applyLimit t d (fromRational totalDueInt) (fromRational totalDueInt) mLimit + + let transferAmt = case CE.liqCredit liq of + Nothing -> supportAmt + (Just v) -> min supportAmt v + + let newBondMap = payInMap d transferAmt L.getTotalDueInt (L.payInt d) bns ByProRata bndMap + let newLiqMap = Map.adjust (CE.draw transferAmt d) pName _liqProvider + return $ t { bonds = newBondMap, liqProvider = Just newLiqMap } + + +-- ^ payout due interest / due fee / oustanding balance to liq provider +performAction d t@TestDeal{accounts=accs,liqProvider = Just _liqProvider} (W.LiqRepay mLimit rpt an pName) + = + let + liqDueAmts CE.LiqBal = [ CE.liqBalance $ _liqProvider Map.! pName] + liqDueAmts CE.LiqInt = [ CE.liqDueInt $ _liqProvider Map.! pName ] + liqDueAmts CE.LiqPremium = [ CE.liqDuePremium $ _liqProvider Map.! pName] + liqDueAmts (CE.LiqRepayTypes lrts) = concat $ liqDueAmts <$> lrts + + overDrawnBalance = maybe 0 negate (CE.liqCredit $ _liqProvider Map.! pName) + + dueBreakdown + | overDrawnBalance > 0 = overDrawnBalance:liqDueAmts rpt + | otherwise = liqDueAmts rpt + + liqTotalDues = sum dueBreakdown + + cap = min liqTotalDues $ A.accBalance $ accs Map.! an + in + do + transferAmt <- applyLimit t d cap cap mLimit + let paidOutsToLiq = paySeqLiabilitiesAmt transferAmt dueBreakdown + + let rptsToPair = case rpt of + CE.LiqRepayTypes lrts -> lrts + x -> [x] + + let paidOutWithType + | overDrawnBalance > 0 = zip (CE.LiqOD:rptsToPair) paidOutsToLiq + | otherwise = zip rptsToPair paidOutsToLiq -- `debug` ("rpts To pair"++ show rptsToPair) + + + let newAccMap = Map.adjust (A.draw transferAmt d (LiquidationSupport pName)) an accs -- `debug` ("repay liq amt"++ show transferAmt) + let newLiqMap = foldl + (\acc (_rpt,_amt) -> Map.adjust (CE.repay _amt d _rpt ) pName acc) + _liqProvider + paidOutWithType + return $ t { accounts = newAccMap, liqProvider = Just newLiqMap } -- paidOutWithType -- `debug` ("paid out"++ show paidOutWithType) + +-- ^ pay yield to liq provider +performAction d t@TestDeal{accounts=accs,liqProvider = Just _liqProvider} (W.LiqYield limit an pName) + = + let cap = A.accBalance $ accs Map.! an in + do + transferAmt <- case limit of + Nothing -> Right (toRational cap) + Just (DS ds) -> (min (toRational cap)) <$> (queryCompound t d (patchDateToStats d ds)) + _ -> Left $ "Date:"++show d ++"Not implement the limit"++ show limit++"For Pay Yield to liqProvider" + + let newAccMap = Map.adjust (A.draw (fromRational transferAmt) d (LiquidationSupport pName)) an accs + let newLiqMap = Map.adjust (CE.repay (fromRational transferAmt) d CE.LiqResidual) pName _liqProvider + return t { accounts = newAccMap, liqProvider = Just newLiqMap } + +performAction d t@TestDeal{liqProvider = Just _liqProvider} (W.LiqAccrue liqNames) + = Right $ t {liqProvider = Just updatedLiqProvider} + where + updatedLiqProvider = mapWithinMap ((updateLiqProvider t d) . (CE.accrueLiqProvider d)) liqNames _liqProvider + + +performAction d t@TestDeal{rateSwap = Just rtSwap } (W.SwapAccrue sName) + = + do + refBal <- case HE.rsNotional (rtSwap Map.! sName) of + (HE.Fixed b) -> Right b + (HE.Base ds) -> fromRational <$> queryCompound t d (patchDateToStats d ds) + (HE.Schedule ts) -> Right . fromRational $ getValByDate ts Inc d + + let newRtSwap = Map.adjust + (HE.accrueIRS d) + sName + (Map.adjust (set HE.rsRefBalLens refBal) sName rtSwap) + return $ t { rateSwap = Just newRtSwap } + + +performAction d t@TestDeal{rateCap = Just rcM, accounts = accsMap } (W.CollectRateCap accName sName) + = Right $ t { rateCap = Just newRcSwap, accounts = newAccMap } + where + receiveAmt = max 0 $ HE.rcNetCash $ rcM Map.! sName + newRcSwap = Map.adjust (HE.receiveRC d) sName rcM -- `debug` ("REceiv AMT"++ show receiveAmt) + newAccMap = Map.adjust (A.deposit receiveAmt d (SwapInSettle sName)) accName accsMap + + +performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapReceive accName sName) + = case (Map.member accName accsMap, Map.member sName rtSwap) of + (False, _) -> Left $ "Date:"++show d ++"Account:"++ show accName ++"not found in SwapReceive" + (_, False) -> Left $ "Date:"++show d ++"Swap:"++ show sName ++"not found in SwapReceive" + _ -> let + receiveAmt = max 0 $ HE.rsNetCash $ rtSwap Map.! sName + newRtSwap = Map.adjust (HE.receiveIRS d) sName rtSwap + newAccMap = Map.adjust (A.deposit receiveAmt d (SwapInSettle sName)) accName accsMap + in + Right $ t { rateSwap = Just newRtSwap, accounts = newAccMap } + +performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapPay accName sName) + = case (Map.member accName accsMap, Map.member sName rtSwap) of + (False, _) -> Left $ "Date:"++show d ++"Account:"++ show accName ++"not found in SwapPay" + (_, False) -> Left $ "Date:"++show d ++"Swap:"++ show sName ++"not found in SwapPay" + _ -> if (HE.rsNetCash (rtSwap Map.! sName)) < 0 then + let + payoutAmt = negate $ HE.rsNetCash $ rtSwap Map.! sName + availBal = A.accBalance $ accsMap Map.! accName + amtToPay = min payoutAmt availBal + newRtSwap = Map.adjust (HE.payoutIRS d amtToPay) sName rtSwap + newAccMap = Map.adjust (A.draw amtToPay d (SwapOutSettle sName)) accName accsMap + in + Right $ t { rateSwap = Just newRtSwap, accounts = newAccMap } + else + Right t + + +performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapSettle accName sName) + = do + t2 <- performAction d t (W.SwapReceive accName sName) + performAction d t2 (W.SwapPay accName sName) + +performAction d t@TestDeal{ triggers = Just trgM } (W.RunTrigger loc tNames) + = do + tList <- newTrgList + return $ + let + newTrgMap = Map.fromList $ zip tNames tList + in + t { triggers = Just (Map.insert loc newTrgMap trgM) } + where + triggerM = trgM Map.! loc + triggerList = (triggerM Map.!) <$> tNames + newTrgList = mapM + (testTrigger t d) + triggerList + + +performAction d t (W.Placeholder mComment) = Right t + +performAction d t action = Left $ "failed to match action>>"++show action++">>Deal"++show (name t) diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs new file mode 100644 --- /dev/null +++ b/src/Deal/DealBase.hs @@ -0,0 +1,679 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} + +module Deal.DealBase (TestDeal(..),SPV(..),dealBonds,dealFees,dealAccounts,dealPool,PoolType(..),getIssuanceStats + ,getAllAsset,getAllAssetList,getAllCollectedFrame,getLatestCollectFrame,getAllCollectedTxns + ,getIssuanceStatsConsol,getAllCollectedTxnsList + ,getPoolIds,getBondByName, UnderlyingDeal(..), uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..) + ,sortActionOnDate,dealBondGroups + ,viewDealBondsByNames,poolTypePool,viewBondsInMap,bondGroupsBonds + ,increaseBondPaidPeriod,increasePoolCollectedPeriod + ,DealStatFields(..),getDealStatInt,isPreClosing,populateDealDates + ,bondTraversal,findBondByNames,updateBondInMap + ,_MultiPool,_ResecDeal,uDealFutureCf,uDealFutureScheduleCf + ) + where +import qualified Accounts as A +import qualified Ledger as LD +import qualified Asset as Ast +import qualified Expense as F +import qualified Liability as L +import qualified CreditEnhancement as CE +import qualified Hedge as HE +import qualified Waterfall as W +import qualified Cashflow as CF +import qualified Assumptions as AP +import qualified AssetClass.AssetBase as ACM +import qualified Call as C +import qualified InterestRate as IR +import Stmt +import Lib +import Util +import DateUtil +import Types +import Revolving +import Triggers + +import qualified Data.Map as Map +import qualified Data.Time as T +import qualified Data.Set as S +import qualified Data.DList as DL +import Data.List +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 +import GHC.Generics +import Control.Lens hiding (element) +import Control.Lens.TH +import Data.IntMap (filterWithKey) +import qualified Data.Text as T +import Text.Read (readMaybe) +import qualified Pool as P +import qualified Types as CF + +import Debug.Trace +import qualified Control.Lens as P +debug = flip trace + + +data DealComp = CompBond + | CompAccount + | CompFee + | CompPool + | CompTrigger + | CompLedger + | CompRateSwap + | CompRateCap + | CompCurrencySwap + | CompLiqProvider + deriving (Show,Eq,Ord,Generic,Read) + +data ActionTypeOnDate = DoSettle + | DoAccrue + | DoUpdateRate + +data ActionOnDate = EarnAccInt Date AccName -- ^ sweep bank account interest + | ChangeDealStatusTo Date DealStatus -- ^ change deal status + | AccrueFee Date FeeName -- ^ accure fee + | ResetLiqProvider Date String -- ^ reset credit for liquidity provider + | ResetLiqProviderRate Date String -- ^ accure interest/premium amount for liquidity provider + | PoolCollection Date String -- ^ collect pool cashflow and deposit to accounts + | RunWaterfall Date String -- ^ execute waterfall on distribution date + | DealClosed Date -- ^ actions to perform at the deal closing day, and enter a new deal status + | FireTrigger Date DealCycle String -- ^ fire a trigger + | InspectDS Date [DealStats] -- ^ inspect formulas + | CalcIRSwap Date String -- ^ calc interest rate swap dates + | SettleIRSwap Date String -- ^ settle interest rate swap dates + | AccrueCapRate Date String -- ^ reset interest rate cap dates + | ResetBondRate Date String -- ^ reset bond interest rate per bond's interest rate info + | StepUpBondRate Date String -- ^ reset bond interest rate per bond's interest rate info + | ResetSrtRate Date String + | ResetAccRate Date String + | AccrueSrt Date String + | MakeWhole Date Spread (Table Float Spread) + | IssueBond Date (Maybe Pre) String AccName L.Bond (Maybe DealStats) (Maybe DealStats) + | FundBond Date (Maybe Pre) String AccName Amount + | RefiBondRate Date AccountName BondName L.InterestInfo + | 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) + +instance Ord ActionOnDate where + compare a1 a2 = compare (getDate a1) (getDate a2) + +instance Eq ActionOnDate where + a1 == a2 = getDate a1 == getDate a2 + + +instance TimeSeries ActionOnDate where + getDate (RunWaterfall d _) = d + getDate (ResetLiqProvider d _) = d + getDate (PoolCollection d _) = d + getDate (EarnAccInt d _) = d + getDate (AccrueFee d _) = d + getDate (DealClosed d) = d + getDate (FireTrigger d _ _) = d + getDate (ChangeDealStatusTo d _ ) = d + getDate (InspectDS d _ ) = d + getDate (CalcIRSwap d _ ) = d + getDate (SettleIRSwap d _ ) = d + getDate (AccrueCapRate d _ ) = d + getDate (ResetBondRate d _) = d + getDate (StepUpBondRate d _) = d + getDate (ResetAccRate d _ ) = d + getDate (MakeWhole d _ _) = d + getDate (BuildReport sd ed) = ed + getDate (IssueBond d _ _ _ _ _ _) = d + getDate (RefiBondRate d _ _ _) = d + getDate (RefiBond d _ _) = d + 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 + + +sortActionOnDate :: ActionOnDate -> ActionOnDate -> Ordering +sortActionOnDate a1 a2 + | d1 == d2 = case (a1,a2) of + (PoolCollection {}, DealClosed {}) -> LT -- pool collection should be executed before deal closed + (DealClosed {}, PoolCollection {}) -> GT -- pool collection should be executed before deal closed + (BuildReport sd1 ed1 ,_) -> GT -- build report should be executed last + (_ , BuildReport sd1 ed1) -> LT -- build report should be executed last + (TestCall _ ,_) -> GT -- test call should be executed last + (_ , TestCall _) -> LT -- test call should be executed last + (CalcIRSwap _ _ ,SettleIRSwap _ _) -> LT -- reset interest swap should be first + (SettleIRSwap _ _ ,CalcIRSwap _ _) -> GT -- reset interest swap should be first + (_ , CalcIRSwap _ _) -> GT -- reset interest swap should be first + (CalcIRSwap _ _ ,_) -> LT -- reset interest swap should be first + (_ , CalcIRSwap _ _) -> GT -- reset interest swap should be first + (StepUpBondRate {} ,_) -> LT -- step up bond rate should be first + (_ , StepUpBondRate {}) -> GT -- step up bond rate should be first + (ResetBondRate {} ,_) -> LT -- reset bond rate should be first + (_ , ResetBondRate {}) -> GT -- reset bond rate should be first + (EarnAccInt {} ,_) -> LT -- earn should be first + (_ , EarnAccInt {}) -> GT -- earn should be first + (ResetLiqProvider {} ,_) -> LT -- reset liq be first + (_ , ResetLiqProvider {}) -> GT -- reset liq be first + (PoolCollection {}, RunWaterfall {}) -> LT -- pool collection should be executed before waterfall + (RunWaterfall {}, PoolCollection {}) -> GT -- pool collection should be executed before waterfall + (_,_) -> EQ + | otherwise = compare d1 d2 + where + d1 = getDate a1 + d2 = getDate a2 + + +type CutoffDate = Date +type ClosingDate = Date +type RevolvingDate = Date +type StatedDate = Date +type DistributionDates = DatePattern +type PoolCollectionDates = DatePattern + + +data DateDesp = PreClosingDates CutoffDate ClosingDate (Maybe RevolvingDate) StatedDate (Date,PoolCollectionDates) (Date,DistributionDates) + -- + -- (last collect,last pay), mRevolving end-date dp1-pool-pay dp2-bond-pay + | CurrentDates (Date,Date) (Maybe Date) StatedDate (Date,PoolCollectionDates) (Date,DistributionDates) + -- Dict based + | GenericDates (Map.Map DateType DatePattern) + deriving (Show,Eq, Generic,Ord) + + +populateDealDates :: DateDesp -> DealStatus -> Either String (Date,Date,Date,[ActionOnDate],[ActionOnDate],Date,[ActionOnDate]) +populateDealDates (PreClosingDates cutoff closing mRevolving end (firstCollect,poolDp) (firstPay,bondDp)) _ + = Right (cutoff,closing,firstPay,pa,ba,end, []) + where + pa = [ PoolCollection _d "" | _d <- genSerialDatesTill2 IE firstCollect poolDp end ] + ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE firstPay bondDp end ] + +populateDealDates (CurrentDates (lastCollect,lastPay) mRevolving end (nextCollect,poolDp) (nextPay,bondDp)) _ + = Right (lastCollect, lastPay,head futurePayDates, pa, ba, end, []) + where + futurePayDates = genSerialDatesTill2 IE nextPay bondDp end + ba = [ RunWaterfall _d "" | _d <- futurePayDates] + futureCollectDates = genSerialDatesTill2 IE nextCollect poolDp end + pa = [ PoolCollection _d "" | _d <- futureCollectDates] + +populateDealDates (GenericDates m) + (PreClosing _) + = let + requiredFields = (CutoffDate, ClosingDate, FirstPayDate, StatedMaturityDate + , DistributionDates, CollectionDates) + vals = lookupTuple6 requiredFields m + + isCustomWaterfallKey (CustomExeDates _) _ = True + isCustomWaterfallKey _ _ = False + custWaterfall = Map.toList $ Map.filterWithKey isCustomWaterfallKey m + in + case vals of + (Just (SingletonDate coffDate), Just (SingletonDate closingDate), Just (SingletonDate fPayDate) + , Just (SingletonDate statedDate), Just bondDp, Just poolDp) + -> let + pa = [ PoolCollection _d "" | _d <- genSerialDatesTill2 IE closingDate poolDp statedDate ] + ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE fPayDate bondDp statedDate ] + cu = [ RunWaterfall _d custName | (CustomExeDates custName, custDp) <- custWaterfall + , _d <- genSerialDatesTill2 EE closingDate custDp statedDate ] + in + Right (coffDate, closingDate, fPayDate, pa, ba, statedDate, cu) + _ + -> Left "Missing required dates in GenericDates in deal status PreClosing" + +populateDealDates (GenericDates m) _ + = let + requiredFields = (LastCollectDate, LastPayDate, NextPayDate, StatedMaturityDate + , DistributionDates, CollectionDates) + vals = lookupTuple6 requiredFields m + + isCustomWaterfallKey (CustomExeDates _) _ = True + isCustomWaterfallKey _ _ = False + custWaterfall = Map.toList $ Map.filterWithKey isCustomWaterfallKey m + in + case vals of + (Just (SingletonDate lastCollect), Just (SingletonDate lastPayDate), Just (SingletonDate nextPayDate) + , Just (SingletonDate statedDate), Just bondDp, Just poolDp) + -> let + pa = [ PoolCollection _d "" | _d <- genSerialDatesTill2 EE lastCollect poolDp statedDate ] + ba = [ RunWaterfall _d "" | _d <- genSerialDatesTill2 IE nextPayDate bondDp statedDate ] + cu = [ RunWaterfall _d custName | (CustomExeDates custName, custDp) <- custWaterfall + , _d <- genSerialDatesTill2 EE lastCollect custDp statedDate ] + in + Right (lastCollect, lastPayDate, nextPayDate, pa, ba, statedDate, cu) -- `debug` ("custom action"++ show cu) + _ + -> Left "Missing required dates in GenericDates in deal status PreClosing" + + + +class SPV a where + getBondsByName :: a -> Maybe [String] -> Map.Map String L.Bond + getActiveBonds :: a -> [String] -> [L.Bond] + getBondBegBal :: a -> String -> Balance + getBondStmtByName :: a -> Maybe [String] -> Map.Map String (Maybe Statement) + getFeeByName :: a -> Maybe [String] -> Map.Map String F.Fee + getAccountByName :: a -> Maybe [String] -> Map.Map String A.Account + isResec :: a -> Bool + getNextBondPayDate :: a -> Date + 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 :: CF.CashFlowFrame + ,futureScheduleCf :: CF.CashFlowFrame + ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) +} deriving (Generic,Eq,Ord,Show) + +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) CF.CashFlowFrame +uDealFutureCf = lens getter setter + where + getter = futureCf + setter ud newCf = ud {futureCf = newCf} + +uDealFutureTxn :: Ast.Asset a => Lens' (UnderlyingDeal a) [CF.TsRow] +uDealFutureTxn = lens getter setter + where + 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 + + +instance SPV (TestDeal a) where + getBondsByName t bns + = case bns of + Nothing -> bonds t + Just _bns -> Map.filterWithKey (\k _ -> S.member k (S.fromList _bns)) (bonds t) + + getActiveBonds t bns = + let + bnds = (bonds t Map.!) <$> bns + in + filter (not . L.isPaidOff) bnds + + getBondStmtByName t bns + = Map.map L.bndStmt bndsM + where + bndsM = Map.map L.consolStmt $ getBondsByName t bns + + getNextBondPayDate t + = case populateDealDates (dates t) (status t) of + Right _dates -> view _3 _dates + Left _ -> error "Failed to populate dates" + + getBondBegBal t bn + = + case b of + Nothing -> 0 + Just bnd -> + case L.bndStmt bnd of + Nothing -> L.getCurBalance bnd -- `debug` ("Getting beg bal nothing"++bn) + Just (Statement txns) + | DL.empty == txns -> L.getCurBalance bnd + | otherwise -> getTxnBegBalance $ head (DL.toList txns) -- `debug` ("Getting beg bal"++bn++"Last smt"++show (head stmts)) + where + b = find (\x -> ((L.bndName x) == bn)) (viewDealAllBonds t) + + getFeeByName t fns + = case fns of + Nothing -> fees t + Just _fns -> Map.filterWithKey (\k _ -> S.member k (S.fromList _fns)) (fees t) + + getAccountByName t ans + = case ans of + Nothing -> accounts t + Just _ans -> Map.filterWithKey (\k _ -> S.member k (S.fromList _ans)) (accounts t) + + isResec t = case pool t of + ResecDeal _ -> True + _ -> False + + getOustandingBal t@TestDeal{ bonds = bndMap, fees= feeMap, liqProvider = mliqMap, rateSwap = rsMap} + = let + bndBal = sum $ getOutstandingAmount <$> Map.elems bndMap + feeBal = sum $ getOutstandingAmount <$> Map.elems feeMap + lqBalace m + | not (Map.null m) = sum $ getOutstandingAmount <$> Map.elems m + | otherwise = 0 + rsBalance m + | not (Map.null m) = sum $ getOutstandingAmount <$> Map.elems m + | otherwise = 0 + in + bndBal + feeBal + lqBalace (fromMaybe Map.empty mliqMap) + rsBalance (fromMaybe Map.empty rsMap) + +isPreClosing :: TestDeal a -> Bool +isPreClosing t@TestDeal{ status = PreClosing _ } = True +isPreClosing _ = False + + +-- ^ list all bonds and bond groups in list +viewDealAllBonds :: TestDeal a -> [L.Bond] +viewDealAllBonds d = + let + bs = Map.elems (bonds d) + view a@(L.Bond {} ) = [a] + view a@(L.BondGroup bMap _) = Map.elems bMap + view a@(L.MultiIntBond {}) = [a] + in + concat $ view <$> bs + +-- ^ flatten all bonds/bond groups in a map +viewBondsInMap :: TestDeal a -> Map.Map String L.Bond +viewBondsInMap t@TestDeal{ bonds = bndMap } + = let + bnds = viewDealAllBonds t + bndNames = L.bndName <$> bnds + in + Map.fromList $ zip bndNames bnds + +-- ^ support bond group +viewDealBondsByNames :: Ast.Asset a => TestDeal a -> [BondName] -> [L.Bond] +viewDealBondsByNames _ [] = [] +viewDealBondsByNames t@TestDeal{bonds= bndMap } bndNames + = let + -- bonds and bond groups + bnds = filter (\b -> L.bndName b `elem` bndNames) $ viewDealAllBonds t + -- bndsFromGrp = $ Map.filter (\L.BondGroup {} -> True) bndMap + bndsFromGrp = Map.foldrWithKey + (\k (L.BondGroup bMap _) acc -> + if k `elem` bndNames + then + acc ++ Map.elems bMap + else + acc) + [] + (view dealBondGroups t ) + in + bnds ++ bndsFromGrp + +-- ^ find bonds with first match +findBondByNames :: Map.Map String L.Bond -> [BondName] -> Either String [L.Bond] +findBondByNames bMap bNames + = let + (firstMatch, notMatched) = Map.partitionWithKey (\k _ -> k `elem` bNames) bMap + remainNames::[String] = bNames \\ Map.keys firstMatch + listOfBondGrps::[Map.Map String L.Bond] = [ bM | (bM,_) <-catMaybes $ (preview L._BondGroup) <$> Map.elems notMatched ] + (secondMatch, notMatched2) = Map.partitionWithKey (\k _ -> k `elem` remainNames) $ Map.unions listOfBondGrps + in + if Map.null notMatched2 then + Right $ Map.elems firstMatch ++ Map.elems secondMatch + else + Left $ "Failed to find bonds by names:"++ show (Map.keys notMatched2) + +-- ^ not support bond group +dealBonds :: Ast.Asset a => Lens' (TestDeal a) (Map.Map BondName L.Bond) +dealBonds = lens getter setter + where + getter d = bonds d + setter d newBndMap = d {bonds = newBndMap} + +-- ^ get & set bond group only +dealBondGroups :: Ast.Asset a => Lens' (TestDeal a) (Map.Map BondName L.Bond) +dealBondGroups = lens getter setter + where + getter d = Map.filter (has L._BondGroup) (bonds d) + setter d newBndMap = d {bonds = Map.filter (has L._BondGroup) newBndMap} + +bondGroupsBonds :: Lens' L.Bond (Map.Map BondName L.Bond) +bondGroupsBonds = lens getter setter + where + getter (L.BondGroup bMap _) = bMap + getter _ = Map.empty + 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 + getter d = accounts d + setter d newAccMap = d {accounts = newAccMap} + +dealFees :: Ast.Asset a => Lens' (TestDeal a) (Map.Map FeeName F.Fee) +dealFees = lens getter setter + where + getter d = fees d + setter d newFeeMap = d {fees = newFeeMap} + +dealPool :: Ast.Asset a => Lens' (TestDeal a) (PoolType a) +dealPool = lens getter setter + where + 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 + getter = \case MultiPool pm -> pm + setter (MultiPool pm) newPm = MultiPool newPm + +poolTypeUnderDeal :: Ast.Asset a => Lens' (PoolType a) (Map.Map PoolId (UnderlyingDeal a)) +poolTypeUnderDeal = lens getter setter + where + getter = \case ResecDeal dm -> dm + setter (ResecDeal dm) newDm = ResecDeal newDm + +-- 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} + = case pt of + MultiPool pm -> Map.keys pm + ResecDeal pm -> Map.keys pm + _ -> error "failed to match pool type in pool ids" + +-- ^ to handle with bond group, with flag to good deep if it is a bond group +getBondByName :: Ast.Asset a => TestDeal a -> Bool -> BondName -> Maybe L.Bond +getBondByName t False bName = Map.lookup bName (bonds t) +getBondByName t True bName = + let + bnds = viewDealAllBonds t + in + find (\b -> L.bndName b == bName) bnds + +-- ^ get issuance pool stat from pool map +getIssuanceStats :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Map.Map CutoffFields Balance) +getIssuanceStats t@TestDeal{pool = pt} mPoolId + = case pt of + ResecDeal uDeals -> + let + selecteduDeals = case mPoolId of + Nothing -> uDeals + Just pns -> Map.filterWithKey (\k _ -> k `elem` pns ) uDeals + in + Map.map (fromMaybe Map.empty . issuanceStat) selecteduDeals + MultiPool pm -> let + selectedPools = case mPoolId of + Nothing -> pm + Just pns -> Map.filterWithKey (\k _ -> k `elem` pns ) pm + in + Map.map (fromMaybe Map.empty . P.issuanceStat) selectedPools + +getIssuanceStatsConsol :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map CutoffFields Balance +getIssuanceStatsConsol t mPns + = let + ms = getIssuanceStats t mPns + in + Map.unionsWith (+) $ Map.elems ms + +getAllAsset :: TestDeal a -> Maybe [PoolId] -> Map.Map PoolId [a] +getAllAsset t@TestDeal{pool = pt} mPns = + let + assetMap = case pt of + MultiPool pm -> Map.map P.assets pm + ResecDeal _ -> Map.empty + -- ResecDeal pm -> Map.mapWithKey (\(UnderlyingBond (bn,hpct,sd), d) -> getAllAsset d Nothing) pm + in + case mPns of + Nothing -> assetMap + Just pns -> Map.filterWithKey (\k _ -> k `elem` pns ) assetMap + +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 CF.CashFlowFrame +getAllCollectedFrame t@TestDeal{pool = poolType} mPid = + let + 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) + Just pids -> Map.filterWithKey (\k _ -> k `elem` pids) mCf -- `debug` ("Just when collecting cfs"++show mCf) + +getLatestCollectFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe CF.TsRow) +getLatestCollectFrame t mPns = Map.map (\case + (CF.CashFlowFrame (_,_,_) []) -> Nothing + (CF.CashFlowFrame (_,_,_) txns) -> Just $ last txns + ) + (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 listOfTxns + where + listOfTxns = Map.elems $ getAllCollectedTxns t mPns + +increasePoolCollectedPeriod :: TestDeal a -> TestDeal a +increasePoolCollectedPeriod t@TestDeal{stats = (balMap,rateMap,boolMap,intMap)} + = let + intMap' = Map.insertWith (+) PoolCollectedPeriod 1 intMap + in + t {stats = (balMap,rateMap,boolMap,intMap')} + +increaseBondPaidPeriod :: TestDeal a -> TestDeal a +increaseBondPaidPeriod t@TestDeal{stats = (balMap,rateMap,boolMap,intMap)} + = let + intMap' = Map.insertWith (+) BondPaidPeriod 1 intMap + in + t {stats = (balMap,rateMap,boolMap,intMap')} + +getDealStatInt :: TestDeal a -> DealStatFields -> Maybe Int +getDealStatInt t@TestDeal{stats = (balMap,rateMap,boolMap,intMap)} f + = Map.lookup f intMap + +bondTraversal :: Traversal' (TestDeal a) L.Bond +bondTraversal f t@TestDeal{bonds = bndMap} = + (\newBndMap -> t {bonds = newBndMap}) <$> traverse f bndMap + +data UnderBond b = UnderBond BondName Rate (TestDeal b) + +opts :: JSONKeyOptions +opts = defaultJSONKeyOptions + +instance ToJSONKey DealStatFields where + toJSONKey = genericToJSONKey opts +instance FromJSONKey DealStatFields where + fromJSONKey = genericFromJSONKey opts + + +$(concat <$> traverse (deriveJSON defaultOptions) [''TestDeal, ''UnderlyingDeal, ''PoolType, ''DateDesp, ''ActionOnDate]) diff --git a/src/Deal/DealDate.hs b/src/Deal/DealDate.hs new file mode 100644 --- /dev/null +++ b/src/Deal/DealDate.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} + +module Deal.DealDate (DealDates,getClosingDate,getFirstPayDate,getLastPayDate) + where + +import qualified Data.Map as Map +import Deal.DealBase +import Types +import Lib + +class DealDates a where + getClosingDate :: a -> Either String Date + getFirstPayDate :: a -> Date + getLastPayDate :: a -> Either String Date + +instance DealDates DateDesp where + getClosingDate (GenericDates m) = case Map.lookup ClosingDate m of + Just (SingletonDate x) -> Right x + Nothing -> Left $ "ClosingDate not found in GenericDates"++show m + + getClosingDate (PreClosingDates _ x _ _ _ _) = Right x + + getClosingDate (CurrentDates (_,cd) _ _ _ _ ) = Right cd + + getLastPayDate (GenericDates m) = case Map.lookup LastPayDate m of + Just (SingletonDate x) -> Right x + Nothing -> Left $ "LastPayDate not found in GenericDates"++ show m + + getLastPayDate (CurrentDates (_,cd) _ _ _ _ ) = Right cd + + getLastPayDate (PreClosingDates {}) = Left "Error : try to get last pay date from PreClosingDates" + + getFirstPayDate (PreClosingDates _ _ _ _ _ (fp,_)) = fp + + getFirstPayDate (CurrentDates _ _ _ _ (cpay,_)) = cpay + + getFirstPayDate (GenericDates m) = case Map.lookup FirstPayDate m of + Just (SingletonDate x) -> x + Nothing -> error "FirstPayDate not found in GenericDates" diff --git a/src/Deal/DealMod.hs b/src/Deal/DealMod.hs new file mode 100644 --- /dev/null +++ b/src/Deal/DealMod.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} + +module Deal.DealMod (modDeal, ModifyType(..), AdjStrategy(..) + ) + where + +import Data.Aeson +import Data.Aeson.Types +import Data.Aeson.TH +import Data.Aeson.Encode.Pretty (encodePretty) +import Servant.OpenApi +import Data.OpenApi hiding (Server,contentType,trace) + +import qualified Accounts as A +import qualified Ledger as LD +import qualified Asset as Ast +import qualified Expense as F +import qualified Liability as L +import qualified CreditEnhancement as CE +import qualified Hedge as HE +import qualified Waterfall as W +import qualified Cashflow as CF +import qualified Assumptions as AP +import qualified AssetClass.AssetBase as ACM +import qualified Call as C +import qualified InterestRate as IR +import qualified Util as U +import qualified Deal.DealBase as DB +import Stmt +import Lib +import Util +import DateUtil +import Types +import Revolving +import Triggers + +import qualified Data.Map as Map +import qualified Data.Time as T +import qualified Data.Set as S +import Data.List +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 +import GHC.Generics +import Control.Lens hiding (element) +import Control.Lens.TH +import Data.IntMap (filterWithKey) +import qualified Data.Text as T +import Text.Read (readMaybe) +import qualified Pool as P +import qualified Types as CF + +import Debug.Trace +import qualified Control.Lens as P +debug = flip trace + + +data AdjStrategy = ScaleBySpread + | ScaleByFactor + deriving (Show,Generic) + +data ModifyType = AddSpreadToBonds BondName + | SlideBalances BondName BondName + deriving (Show,Generic) + +-- ^ Modify a deal by various type of recipes +modDeal :: Ast.Asset a => ModifyType -> Double -> DB.TestDeal a -> DB.TestDeal a +modDeal (AddSpreadToBonds bnd) sprd d + = let + sprd' = (fromRational . toRational) sprd + bndMap = DB.bonds d + bndMap' = U.mapWithinMap + (\b -> b & L.interestInfoTraversal %~ L.adjInterestInfoBySpread sprd' + & L.curRatesTraversal %~ (+ sprd')) + [bnd] + 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 + + +$(deriveJSON defaultOptions ''AdjStrategy) +instance ToSchema AdjStrategy + +$(deriveJSON defaultOptions ''ModifyType) +instance ToSchema ModifyType diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs new file mode 100644 --- /dev/null +++ b/src/Deal/DealQuery.hs @@ -0,0 +1,1018 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Deal.DealQuery (queryDealBool ,patchDateToStats,patchDatesToStats,testPre + ,calcTargetAmount, testPre2 + ,queryCompound, calcBondTargetBalance) + where + +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 +import Data.Text (replace, pack, unpack) +import Numeric.Limits +import Control.Monad.Loops +import GHC.Real +import qualified Data.Map as Map +import qualified Data.Set as S +import qualified Liability as L +import qualified Cashflow as CF +import qualified Data.Time as T +import qualified Data.DList as DL +import qualified Accounts as A +import qualified Ledger as LD +import qualified Expense as F +import qualified Triggers as Trg +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 +import DateUtil +import Control.Lens hiding (element) +import Control.Lens.Extras (is) +import Control.Lens.TH +import Control.Applicative +import Data.Map.Lens +import Data.List.Lens +import Debug.Trace +import Lib +import qualified Cashflow as P +debug = flip trace + +-- | calcuate target balance for a reserve account, 0 for a non-reserve account +calcTargetAmount :: P.Asset a => TestDeal a -> Date -> A.Account -> Either String Balance +calcTargetAmount t d (A.Account _ _ _ Nothing _ ) = Right 0 +calcTargetAmount t d (A.Account _ _ _ (Just r) _ ) = + eval r + where + eval :: A.ReserveAmount -> Either String Balance + eval ra = case ra of + A.PctReserve ds _rate -> do + v <- queryCompound t d (patchDateToStats d ds) + return (fromRational (v * _rate)) + A.FixReserve amt -> Right amt + A.Either p ra1 ra2 -> do + q <- testPre d t p + if q then + eval ra1 + else + eval ra2 + A.Max ras -> maximum' <$> sequenceA (eval <$> ras) + A.Min ras -> minimum' <$> sequenceA (eval <$> ras) + +-- | calculate target bond balance for a bond +calcBondTargetBalance :: P.Asset a => TestDeal a -> Date -> L.Bond -> Either String Balance +calcBondTargetBalance t d (L.BondGroup bMap mPt) = + case mPt of + Nothing -> do + vs <- sequenceA $ calcBondTargetBalance t d <$> Map.elems bMap + return $ sum vs + + Just (L.PAC _target) -> Right $ getValOnByDate _target d + Just (L.PacAnchor _target _bnds) + | queryDealBool t (IsPaidOff _bnds) d == Right True -> + do + subBondTargets <- sequenceA $ calcBondTargetBalance t d <$> Map.elems bMap + return $ sum subBondTargets + | queryDealBool t (IsPaidOff _bnds) d == Right False -> Right $ getValOnByDate _target d + | otherwise -> Left $ "Calculate paid off bonds failed"++ show _bnds ++" in calc target balance" + Just (L.AmtByPeriod pc) -> case getValFromPerCurve pc Past Inc (fromMaybe 0 (getDealStatInt t BondPaidPeriod)) of + Just v -> Right v + Nothing -> Left "Failed to find value in calcTargetBalance" + _ -> Left $ "not support principal type for bond group"++ show mPt +calcBondTargetBalance t d b = + case L.bndType b of + L.Sequential -> Right 0 + L.Lockout ld | d >= ld -> Right 0 + | otherwise -> Right $ L.bndBalance b + L.Z + | all (==True) (isPaidOff <$> (Map.elems (Map.delete (L.bndName b) (bonds t)))) -> Right 0 + | otherwise -> Right $ L.bndBalance b + L.IO -> Right 0 + L.Equity -> Right 0 + L.PAC _target -> Right $ getValOnByDate _target d + L.PacAnchor _target _bnds + | queryDealBool t (IsPaidOff _bnds) d == Right True -> Right 0 + | queryDealBool t (IsPaidOff _bnds) d == Right False -> Right $ getValOnByDate _target d + | otherwise -> Left $ "Calculate paid off bonds failed"++ show _bnds ++" in calc target balance" + L.AmtByPeriod pc -> case getValFromPerCurve pc Past Inc (fromMaybe 0 (getDealStatInt t BondPaidPeriod)) of + Just v -> Right v + Nothing -> Left "Failed to find value in calcTargetBalance" + _ -> Left $ "Bond "++ L.bndName b ++" is not a bond with target balance setting" + + +patchDateToStats :: Date -> DealStats -> DealStats +patchDateToStats d t + = case t of + CurrentPoolBalance mPns -> FutureCurrentPoolBalance mPns + CurrentPoolBegBalance mPns -> FutureCurrentPoolBegBalance mPns + PoolFactor mPns -> FutureCurrentPoolFactor d mPns + LastBondIntPaid bns -> BondsIntPaidAt d bns + LastFeePaid fns -> FeesPaidAt d fns + LastBondPrinPaid bns -> BondsPrinPaidAt d bns + BondBalanceGap bn -> BondBalanceGapAt d bn + ReserveGap ans -> ReserveGapAt d ans + ReserveExcess ans -> ReserveExcessAt d ans + Sum _ds -> Sum $ map (patchDateToStats d) _ds + Substract _ds -> Substract $ map (patchDateToStats d) _ds + Subtract _ds -> Subtract $ map (patchDateToStats d) _ds + Min dss -> Min $ [ patchDateToStats d ds | ds <- dss ] + Max dss -> Max $ [ patchDateToStats d ds | ds <- dss ] + Factor _ds r -> Factor (patchDateToStats d _ds) r + FloorWithZero ds -> FloorWithZero (patchDateToStats d ds) + UseCustomData n -> CustomData n d + CurrentPoolBorrowerNum mPns -> FutureCurrentPoolBorrowerNum d mPns + FeeTxnAmt ns mCmt -> FeeTxnAmtBy d ns mCmt + BondTxnAmt ns mCmt -> BondTxnAmtBy d ns mCmt + AccTxnAmt ns mCmt -> AccTxnAmtBy d ns mCmt -- `debug` ("Hitttt") + PoolScheduleCfPv pm pns -> FuturePoolScheduleCfPv d pm pns + Excess dss -> Excess $ [ patchDateToStats d ds | ds <- dss ] + Abs ds -> Abs $ patchDateToStats d ds + Avg dss -> Avg $ [ patchDateToStats d ds | ds <- dss ] + Divide ds1 ds2 -> Divide (patchDateToStats d ds1) (patchDateToStats d ds2) + FloorAndCap f c s -> FloorAndCap (patchDateToStats d f) (patchDateToStats d c) (patchDateToStats d s) + Multiply dss -> Multiply $ [ patchDateToStats d ds | ds <- dss ] + FloorWith ds f -> FloorWith (patchDateToStats d ds) (patchDateToStats d f) + CapWith ds c -> CapWith (patchDateToStats d ds) (patchDateToStats d c) + Round ds rb -> Round (patchDateToStats d ds) rb + DivideRatio ds1 ds2 -> DivideRatio (patchDateToStats d ds1) (patchDateToStats d ds2) + AvgRatio ss -> AvgRatio $ [ patchDateToStats d ds | ds <- ss ] + _ -> t -- `debug` ("Failed to patch date to stats"++show t) + +patchDatesToStats :: P.Asset a => TestDeal a -> Date -> Date -> DealStats -> DealStats +patchDatesToStats t d1 d2 ds + = case ds of + CurrentBondBalanceOf bns -> WeightedAvgCurrentBondBalance d1 d2 bns + OriginalBondBalanceOf bns -> WeightedAvgOriginalBondBalance d1 d2 bns + CurrentPoolBalance mPns -> WeightedAvgCurrentPoolBalance d1 d2 mPns + OriginalPoolBalance mPns -> WeightedAvgOriginalPoolBalance d1 d2 mPns + CurrentBondBalance -> WeightedAvgCurrentBondBalance d1 d2 (Map.keys $ bonds t) + OriginalBondBalance -> WeightedAvgOriginalBondBalance d1 d2 (Map.keys $ bonds t) + Excess dss -> Excess $ [ patchDatesToStats t d1 d2 ds | ds <- dss ] + Abs ds -> Abs $ patchDatesToStats t d1 d2 ds + Avg dss -> Avg $ [ patchDatesToStats t d1 d2 ds | ds <- dss ] + Divide ds1 ds2 -> Divide (patchDatesToStats t d1 d2 ds1) (patchDatesToStats t d1 d2 ds2) + FloorAndCap f c s -> FloorAndCap (patchDatesToStats t d1 d2 f) (patchDatesToStats t d1 d2 c) (patchDatesToStats t d1 d2 s) + Multiply dss -> Multiply $ [ patchDatesToStats t d1 d2 ds | ds <- dss ] + FloorWith ds f -> FloorWith (patchDatesToStats t d1 d2 ds) (patchDatesToStats t d1 d2 f) + CapWith ds c -> CapWith (patchDatesToStats t d1 d2 ds) (patchDatesToStats t d1 d2 c) + Round ds rb -> Round (patchDatesToStats t d1 d2 ds) rb + Sum dss -> Sum $ [ patchDatesToStats t d1 d2 ds | ds <- dss ] + DivideRatio ds1 ds2 -> DivideRatio (patchDatesToStats t d1 d2 ds1) (patchDatesToStats t d1 d2 ds2) + AvgRatio ss -> AvgRatio $ [ patchDatesToStats t d1 d2 ds | ds <- ss ] + x -> x + + +-- ^ map from Pool Source to Pool CutoffFields in Pool Map +poolSourceToIssuanceField :: PoolSource -> CutoffFields +poolSourceToIssuanceField CollectedInterest = HistoryInterest +poolSourceToIssuanceField CollectedPrincipal = HistoryPrincipal +poolSourceToIssuanceField CollectedRecoveries = HistoryRecoveries +poolSourceToIssuanceField CollectedPrepayment = HistoryPrepayment +poolSourceToIssuanceField CollectedPrepaymentPenalty = HistoryPrepaymentPentalty +poolSourceToIssuanceField CollectedRental = HistoryRental +poolSourceToIssuanceField CollectedFeePaid = HistoryFeePaid +poolSourceToIssuanceField CollectedCash = HistoryCash +poolSourceToIssuanceField NewLosses = HistoryLoss +poolSourceToIssuanceField NewDefaults = HistoryDefaults +poolSourceToIssuanceField NewDelinquencies = HistoryDelinquency +poolSourceToIssuanceField a = error ("Failed to match pool source when mapping to issuance field"++show a) + + + +queryCompound :: P.Asset a => TestDeal a -> Date -> DealStats -> Either String Rational +queryCompound t@TestDeal{accounts=accMap, bonds=bndMap, ledgers=ledgersM, fees=feeMap, pool=pt} + d s = + case s of + Sum _s -> sum <$> sequenceA [ queryCompound t d __s | __s <- _s] + Substract dss -> queryCompound t d (Subtract dss) + Subtract (ds:dss) -> + do + a <- queryCompound t d ds + bs <- queryCompound t d (Sum dss) + return $ a - bs + Avg dss -> (/ (toRational (length dss))) <$> (sum <$> sequenceA (queryCompound t d <$> dss )) + Max ss -> maximum' [ queryCompound t d s | s <- ss ] + Min ss -> minimum' [ queryCompound t d s | s <- ss ] + Divide ds1 ds2 -> if (queryCompound t d ds2) == Right 0 then + Left $ "Date:"++show d++"Can not divide zero on ds: "++ show ds2 + else + liftA2 (/) (queryCompound t d ds1) (queryCompound t d ds2) + Factor s f -> (* f) <$> queryCompound t d s + FloorAndCap floor cap s -> max (queryCompound t d floor) $ min (queryCompound t d cap) (queryCompound t d s) + Multiply ss -> product <$> sequenceA [ queryCompound t d _s | _s <- ss] + FloorWith s floor -> liftA2 max (queryCompound t d s) (queryCompound t d floor) + FloorWithZero s -> max 0 <$> queryCompound t d s + Excess (s1:ss) -> do + q1 <- queryCompound t d s1 + q2 <- queryCompound t d (Sum ss) -- `debug` ("Excess"++show (queryCompound t s1)++"ss"++show ( queryCompound t (Sum ss))) + return (max 0 (q1 -q2)) + CapWith s cap -> min (queryCompound t d s) (queryCompound t d cap) + Abs s -> abs <$> queryCompound t d s + Round ds rb -> do + q <- queryCompound t d ds + return $ roundingBy rb q + DivideRatio s1 s2 -> queryCompound t d (Divide s1 s2) + AvgRatio ss -> queryCompound t d (Avg ss) + Constant v -> Right v + -- rate query + BondFactor -> queryCompound t d (Divide CurrentBondBalance OriginalBondBalance) + BondFactorOf bn -> + queryCompound t d (Divide (CurrentBondBalanceOf [bn]) (OriginalBondBalanceOf [bn])) + PoolFactor mPns -> + queryCompound t d (Divide (CurrentPoolBalance mPns) (OriginalPoolBalance mPns)) + FutureCurrentPoolFactor asOfDay mPns -> + queryCompound t d (Divide (FutureCurrentPoolBalance mPns) (OriginalPoolBalance mPns)) + CumulativePoolDefaultedRate mPns -> + queryCompound t d (Divide (PoolCumCollection [NewDefaults] mPns) (OriginalPoolBalance mPns)) + CumulativeNetLossRatio mPns -> + queryCompound t d (Divide (CumulativeNetLoss mPns) (OriginalPoolBalance mPns)) + CumulativePoolDefaultedRateTill idx mPns -> + queryCompound t d (Divide (PoolCumCollectionTill idx [NewDefaults] mPns) (OriginalPoolBalance mPns)) + + BondRate bn -> + case Map.lookup bn (bonds t) of + Just b@(L.Bond {}) -> Right . toRational $ L.getCurRate b + Just b@(L.MultiIntBond {}) -> Right . toRational $ L.getCurRate b + Just b@(L.BondGroup bSubMap _) -> Right . toRational $ L.getCurRate b + Nothing -> + case viewDealBondsByNames t [bn] of + [b] -> Right $ toRational $ L.bndRate b + + BondWaRate bns -> + do + rs <- sequenceA $ (\bn -> queryCompound t d (BondRate bn)) <$> bns + ws <- sequenceA $ (\bn -> queryCompound t d (CurrentBondBalanceOf [bn])) <$> bns + return $ weightedBy (fromRational <$> ws) rs + + PoolWaRate Nothing -> + let + latestCfs = filter isJust $ Map.elems $ getLatestCollectFrame t Nothing + rates = toRational . maybe 0.0 CF.mflowRate <$> latestCfs + bals = maybe 0.0 (view CF.tsRowBalance) <$> latestCfs + in + Right $ weightedBy (toRational <$> bals) rates + + PoolWaRate (Just pName) -> + let + latestCfs = filter isJust $ Map.elems $ getLatestCollectFrame t (Just [pName]) + rates = toRational . maybe 0.0 CF.mflowRate <$> latestCfs + 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 + Just v -> Right . toRational $ v + Nothing -> Left $ "Date:"++show d++"Failed to rate deal stat of -> "++ show s + + + -- int query + FutureCurrentPoolBorrowerNum _d mPns -> + let + poolCfs = Map.elems $ getLatestCollectFrame t mPns + poolBn = maybe 0 (fromMaybe 0 . CF.mflowBorrowerNum) <$> poolCfs + in + Right . toRational $ sum poolBn + + CurrentPoolBorrowerNum mPns -> + let + assetM = concat $ Map.elems $ getAllAsset t mPns + in + Right . toRational $ sum $ P.getBorrowerNum <$> assetM + + MonthsTillMaturity bn -> + do + (L.OriginalInfo _ _ _ mm) <- lookupAndApply L.bndOriginInfo "Get Months till maturity" bn bndMap + case mm of + 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 CF.sizeCashFlowFrame $ getAllCollectedFrame t Nothing + + DealStatInt s -> + case stats t of + (_,_,_,m) -> case Map.lookup s m of + Just v -> Right . toRational $ v + Nothing -> Left $ "Date:"++show d++"Failed to query int deal stat of -> "++ show s ++" in map"++ show m + + + ReserveBalance ans -> + do + accBal <- lookupAndApplies (calcTargetAmount t d) ("Date:"++show d++"Cal Reserve Balance") ans accMap + vs <- sequenceA accBal + return $ toRational (sum vs) + + + ReserveExcessAt _d ans -> + do + q1 <- queryCompound t d (AccBalance ans) + q2 <- queryCompound t d (ReserveBalance ans) + return $ max 0 (q1 - q2) + + ReserveGapAt _d ans -> + do + q1 <- queryCompound t d (AccBalance ans) + q2 <- queryCompound t d (ReserveBalance ans) + return $ max 0 (q2 - q1) + + CurrentBondBalance -> Right . toRational $ Map.foldr (\x acc -> getCurBalance x + acc) 0.0 bndMap + + OriginalBondBalance -> Right . toRational $ Map.foldr (\x acc -> getOriginBalance x + acc) 0.0 bndMap + + BondDuePrin bnds -> Right . toRational $ sum $ L.bndDuePrin <$> viewDealBondsByNames t bnds + + OriginalBondBalanceOf bnds -> Right . toRational $ sum $ getOriginBalance <$> viewDealBondsByNames t bnds + + CurrentBondBalanceOf bns -> Right . toRational $ sum $ getCurBalance <$> viewDealBondsByNames t bns + + BondTotalFunding bnds -> + Right . toRational $ sum $ L.totalFundedBalance <$> viewDealBondsByNames t bnds + + CurrentPoolBalance mPns -> + let + assetM = concat $ Map.elems $ getAllAsset t mPns + in + Right . toRational $ sum $ P.getCurrentBal <$> assetM + + CurrentPoolDefaultedBalance -> + Right . toRational $ + foldl (\acc x -> acc + P.getCurrentBal x) + 0.0 $ + filter P.isDefaulted (getAllAssetList t) + + DealIssuanceBalance mPns -> + Right . toRational $ + sum $ Map.findWithDefault 0.0 IssuanceBalance <$> Map.elems (getIssuanceStats t mPns) + + OriginalPoolBalance mPns -> + let + statsConsol = getIssuanceStatsConsol t mPns + in + case Map.lookup IssuanceBalance statsConsol of + Just v -> Right . toRational $ v + Nothing -> Left $ "Date:"++show d++"No issuance balance found in the pool, pls specify it in the pool stats map `issuanceStat`" + + UnderlyingBondBalance mBndNames -> Left $ "Date:"++show d++"Not implemented for underlying bond balance" + + AllAccBalance -> + Right . toRational $ sum $ map A.accBalance $ Map.elems accMap + + AccBalance ans -> + do + accBals <- lookupAndApplies A.accBalance "AccBalance" ans accMap + return $ (toRational . sum) accBals + + -- ^ negatave -> credit balance , postive -> debit balance + LedgerBalance ans -> + case ledgersM of + Nothing -> Left ("Date:"++show d++"No ledgers were modeled , failed to find ledger:"++show ans ) + Just ledgersM -> + do + lgBals <- lookupAndApplies LD.ledgBalance "Ledger Balance" ans ledgersM + return $ (toRational . sum) lgBals + + LedgerBalanceBy dr ans -> + case ledgersM of + Nothing -> Left ("Date:"++show d++"No ledgers were modeled , failed to find ledger:"++show ans ) + Just ledgersM -> + do + lgdsM <- selectInMap "Look up ledgers" ans ledgersM + let ldgL = Map.elems lgdsM + let bs Credit = filter (\x -> LD.ledgBalance x < 0) ldgL + let bs Debit = filter (\x -> LD.ledgBalance x >= 0) ldgL + return $ toRational $ abs $ sum $ LD.ledgBalance <$> bs dr + + FutureCurrentPoolBalance mPns -> + case (mPns,pt) of + (Nothing, MultiPool pm ) -> queryCompound t d (FutureCurrentPoolBalance (Just $ Map.keys pm)) + (Just pids, MultiPool pm) -> + if S.isSubsetOf (S.fromList pids) (S.fromList (Map.keys pm)) then + let + selectedPools = Map.elems $ Map.filterWithKey (\k _ -> S.member k (S.fromList pids)) pm + in + do + currentBals <- sequenceA $ (`Pl.getIssuanceField` RuntimeCurrentPoolBalance) <$> selectedPools + return $ toRational $ sum currentBals + else + 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 $ ((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 + ltc = getLatestCollectFrame t mPns + in + Right . toRational $ sum $ maybe 0 CF.mflowBegBalance <$> ltc + + PoolCollectionHistory incomeType fromDay asOfDay mPns -> + Right . toRational $ sum fieldAmts + where + mTxns = Map.elems $ getAllCollectedTxns t mPns + subflow = sliceBy EI fromDay asOfDay $ concat mTxns + fieldAmts = map (`CF.lookupSource` incomeType) subflow + + CumulativePoolDefaultedBalance mPns -> + let + latestCollect = getLatestCollectFrame t mPns + futureDefaults = sum $ Map.elems $ Map.map (maybe 0 (fromMaybe 0 . CF.tsCumDefaultBal )) $ latestCollect + in + Right . toRational $ futureDefaults -- `debug` ("future Defaults at"++ show futureDefaults ++ show latestCollect) + + CumulativePoolRecoveriesBalance mPns -> + let + latestCollect = getLatestCollectFrame t mPns + futureRecoveries = sum $ Map.elems $ Map.map (maybe 0 (fromMaybe 0 . CF.tsCumRecoveriesBal)) $ latestCollect + in + Right . toRational $ futureRecoveries + + CumulativeNetLoss mPns -> + liftA2 + (-) + (queryCompound t d (CumulativePoolDefaultedBalance mPns)) + (queryCompound t d (CumulativePoolRecoveriesBalance mPns)) + + PoolCumCollection ps mPns -> + let + collectedTxns = concat . Map.elems $ getAllCollectedTxns t mPns + futureVals = sum $ (CF.lookupSource <$> collectedTxns) <*> ps + + poolStats = Map.elems $ getIssuanceStats t mPns + historyVals = sum $ (Map.findWithDefault 0.0 . poolSourceToIssuanceField <$> ps) <*> poolStats + in + Right . toRational $ futureVals + historyVals + + PoolCumCollectionTill idx ps mPns -> + let + txnMap = Map.map (dropLastN (negate idx)) $ getAllCollectedTxns t mPns + txnList = concat $ Map.elems txnMap + lookupList = CF.lookupSource <$> txnList + futureVals = sum $ lookupList <*> ps + sumMap = getIssuanceStatsConsol t mPns + historyVals = sum $ Map.findWithDefault 0 . poolSourceToIssuanceField <$> ps <*> [sumMap] + in + Right . toRational $ futureVals + historyVals + + PoolCurCollection ps mPns -> + let + pCf = getLatestCollectFrame t mPns -- `debug` ("mPns"++ show mPns) + lastRows = Map.map (maybe 0 (\r -> sum (CF.lookupSource r <$> ps))) pCf -- `debug` ("Latest collect frame"++ show pCf) + in + Right . toRational $ sum $ Map.elems lastRows -- `debug ` ("lst row found"++ show lastRows) + + PoolCollectionStats idx ps mPns -> + let + pCollectedTxns = getAllCollectedTxns t mPns + pStat = Map.map + (\x -> + let + lookupIndx = length x + idx - 1 + in + if (( lookupIndx >= length x ) || (lookupIndx <0)) then + Nothing + else + Just (x!!lookupIndx)) + pCollectedTxns -- `debug` ("date"++show d++"Pool collection: "++ show pCollectedTxns) + in + do + curPoolBalM <- sequenceA $ + Map.mapWithKey + (\k v -> queryCompound t d (FutureCurrentPoolBalance (Just [k]))) + pStat -- `debug` ("date"++show d++"Pool stats collection: "++ show pStat) + let poolStat = Map.mapWithKey + (\k v -> + case v of + Just _v -> sum $ CF.lookupSource _v <$> ps + Nothing -> sum $ CF.lookupSourceM (fromRational (curPoolBalM Map.! k)) Nothing <$> ps) + pStat -- `debug` ("date"++show d++"query pool current pool stat 2" ++ show pStat ) + return $ sum $ Map.elems $ toRational <$> poolStat -- `debug` ("query pool current stats"++ show poolStat) + + FuturePoolScheduleCfPv asOfDay pm mPns -> + let + 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 + txns = cutBy Exc Future asOfDay $ concat $ Map.elems pCfTxns + txnsCfs = CF.tsTotalCash <$> txns -- `debug` ("schedule cf as of "++ show asOfDay ++ ">>" ++ show txns) + txnsDs = getDate <$> txns + txnsRates = CF.mflowRate <$> txns + in + do + scheduleBal <- queryCompound t d (FutureCurrentSchedulePoolBegBalance mPns) + curBal <- queryCompound t d (FutureCurrentPoolBalance mPns) + let factor = case scheduleBal of + 0.00 -> 0 + _ -> curBal / scheduleBal -- `debug` ("cur Bal"++show curBal ++">> sheduleBal"++ show scheduleBal) + let cfForPv = (`mulBR` factor) <$> txnsCfs -- `debug` (">>> factor"++ show factor) + let pvs = case pm of + PvRate r -> uncurry (A.pv2 r asOfDay) <$> zip txnsDs cfForPv + -- _ -> Left $ "Date:"++ show asOfDay ++ "Failed to use pricing method on pool" ++ show pm ++"on pool id"++ show mPns + return $ toRational $ sum pvs + + BondsIntPaidAt d bns -> + let + stmts = map L.bndStmt $ viewDealBondsByNames t bns + ex s = case s of + Nothing -> 0 + Just (Statement txns) + -> sum $ map getTxnAmt $ + filter (\y -> case getTxnComment y of + (PayInt _ ) -> True + _ -> False) $ + filter (\x -> d == getDate x) (DL.toList txns) + in + Right . toRational $ sum $ map ex stmts + + BondsPrinPaidAt d bns -> + let + stmts = map L.bndStmt $ viewDealBondsByNames t bns + ex s = case s of + Nothing -> 0 + Just (Statement txns) + -> sum $ map getTxnAmt $ + filter (\y -> case getTxnComment y of + (PayPrin _ ) -> True + _ -> False) $ + filter (\x -> d == getDate x) (DL.toList txns) + in + Right . toRational $ sum $ map ex stmts + + FeeTxnAmtBy d fns mCmt -> + let + fees = (feeMap Map.!) <$> fns -- Map.elems $ getFeeByName t (Just fns) + in + Right . toRational $ + case mCmt of + Just cmt -> sum [ queryTxnAmtAsOf fee d cmt | fee <- fees ] + Nothing -> + let + _txn = concat [ (DL.toList .getTxns)(F.feeStmt fee) | fee <- fees ] + in + sumTxn $ cutBy Inc Past d _txn + + FeePaidAmt fns -> + let + fees = (feeMap Map.!) <$> fns + feeTxns = concat [ (DL.toList .getTxns) (F.feeStmt fee) | fee <- fees ] + in + Right . toRational $ sumTxn feeTxns + + BondTxnAmtBy d bns mCmt -> + let + bnds = viewDealBondsByNames t bns + in + Right . toRational $ + case mCmt of + Just cmt -> sum [ queryTxnAmtAsOf bnd d cmt | bnd <- bnds ] + Nothing -> + let + _txn = concat [ (DL.toList . getTxns) (L.bndStmt bnd) | bnd <- bnds ] + in + sumTxn $ cutBy Inc Past d _txn + + AccTxnAmtBy d ans mCmt -> + let + accs = (accMap Map.!) <$> ans + in + Right . toRational $ + case mCmt of + Just cmt -> sum [ queryTxnAmtAsOf acc d cmt | acc <- accs ] + Nothing -> + let + _txn = concat [ (DL.toList . getTxns) (A.accStmt acc) | acc <- accs ] + in + sumTxn $ cutBy Inc Past d _txn + + LedgerTxnAmt lns mCmt -> + case ledgersM of + Nothing -> Left $ ("Date:"++show d++"No ledgers were modeled , failed to find ledger:"++show lns ) + Just ledgerm -> + let + lgs = (ledgerm Map.!) <$> lns + in + case mCmt of + Just cmt -> Right . toRational $ sum [ queryTxnAmt lg cmt | lg <- lgs ] + Nothing -> Right . toRational $ sum [ LD.ledgBalance lg | lg <- lgs ] + + BondBalanceGapAt d bName -> + do + tbal <- queryCompound t d (BondBalanceTarget [bName]) + cbal <- queryCompound t d (CurrentBondBalanceOf [bName]) + return $ max 0 $ cbal - tbal -- `debug` (show d ++">"++ "tbal"++show tbal++"cbal"++show cbal) + + BondBalanceTarget bNames -> + do + bnds <- findBondByNames bndMap bNames + targets <- sequenceA $ calcBondTargetBalance t d <$> bnds + return $ toRational $ sum targets + + FeesPaidAt d fns -> + let + fSubMap = getFeeByName t (Just fns) + stmts = map F.feeStmt $ Map.elems fSubMap + ex s = case s of + Nothing -> 0 + Just (Statement txns) -> sum $ getTxnAmt <$> filter (\x -> d == getDate x) (DL.toList txns) + in + Right . toRational $ sum $ map ex stmts + + -- ^ get total int due for bonds + CurrentDueBondInt bns -> + Right . toRational $ sum $ L.getDueInt <$> viewDealBondsByNames t bns + + -- ^ get total int over int due for bonds + CurrentDueBondIntOverInt bns -> + Right . toRational $ sum $ L.getDueIntOverInt <$> viewDealBondsByNames t bns + + -- ^ get total due (due int + int over int due) for bonds + CurrentDueBondIntTotal bns -> + sum <$> sequenceA (queryCompound t d <$> [CurrentDueBondInt bns,CurrentDueBondIntOverInt bns]) + + CurrentDueBondIntAt idx bns -> + let + bs = filter (is L._MultiIntBond) $ viewDealBondsByNames t bns + mDueInts = sequenceA $ (\x -> x ^? ix idx) <$> (L.bndDueInts <$> bs) + in + case mDueInts of + Nothing -> Left $ "Date:"++show d++"Failed to find due int at index for bonds"++ show bns ++ "with Index:"++ show idx ++ " but bonds has "++ show (L.bndDueInts <$> bs) + Just dueInts -> Right . toRational $ sum dueInts + + CurrentDueBondIntOverIntAt idx bns -> + let + bs = filter (is L._MultiIntBond) $ viewDealBondsByNames t bns + mDueInts = sequenceA $ (\x -> x ^? ix idx) <$> (L.bndDueIntOverInts <$> bs) + in + case mDueInts of + Nothing -> Left $ "Date:"++show d++"Failed to find due int over int at index for bonds"++ show bns ++ "with Index:"++ show idx ++ " but bonds has "++ show (L.bndDueIntOverInts <$> bs) + Just dueInts -> Right . toRational $ sum $ dueInts + + CurrentDueBondIntTotalAt idx bns -> + sum <$> sequenceA (queryCompound t d <$> [CurrentDueBondIntAt idx bns,CurrentDueBondIntOverIntAt idx bns]) + + CurrentDueFee fns -> + do + vs <- lookupAndApplies F.feeDue "Get Current Due Fee" fns feeMap + return $ toRational (sum vs) + + LiqCredit lqNames -> + case liqProvider t of + Nothing -> Left $ "Date:"++show d++"No Liquidation Provider modeled when looking for " ++ show s + Just liqProviderM -> Right . toRational $ + sum $ [ fromMaybe 0 (CE.liqCredit liq) | (k,liq) <- Map.assocs liqProviderM + , S.member k (S.fromList lqNames) ] + + LiqBalance lqNames -> + case liqProvider t of + Nothing -> Left $ "Date:"++show d++"No Liquidation Provider modeled when looking for " ++ show s + Just liqProviderM -> Right . toRational $ + sum $ [ CE.liqBalance liq | (k,liq) <- Map.assocs liqProviderM + , S.member k (S.fromList lqNames) ] + + RateCapNet rcName -> case rateCap t of + Nothing -> Left $ "Date:"++show d++"No Rate Cap modeled when looking for " ++ show s + Just rm -> case Map.lookup rcName rm of + Nothing -> Left $ "Date:"++show d++"No Rate Cap modeled when looking for " ++ show s + Just rc -> Right . toRational $ H.rcNetCash rc + + RateSwapNet rsName -> case rateCap t of + Nothing -> Left $ "Date:"++show d++"No Rate Swap modeled when looking for " ++ show s + Just rm -> case Map.lookup rsName rm of + Nothing -> Left $ "Date:"++show d++"No Rate Swap modeled when looking for " ++ show s + Just rc -> Right . toRational $ H.rcNetCash rc + + WeightedAvgCurrentBondBalance d1 d2 bns -> + Right . toRational $ + Map.foldr (\v a-> a + (L.weightAverageBalance d1 d2 v)) + 0.0 + (getBondsByName t (Just bns)) + + WeightedAvgCurrentPoolBalance d1 d2 mPns -> + let + 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 $ Map.elems waBalByPool + + WeightedAvgOriginalBondBalance d1 d2 bns -> + let + bnds = viewDealBondsByNames t bns + oBals = getOriginBalance <$> bnds + bgDates = L.originDate . L.bndOriginInfo <$> bnds -- `debug` ("bals"++show oBals++">>"++ show d1++"-"++show d2) + in + Right . toRational $ + sum $ (\(b,sd) -> mulBR b (yearCountFraction DC_ACT_365F (max d1 sd) d2)) <$> (zip oBals bgDates) -- `debug` ("bgDates"++show bgDates) + + WeightedAvgOriginalPoolBalance d1 d2 mPns -> + Right . toRational $ + mulBR + (Map.findWithDefault 0.0 IssuanceBalance (getIssuanceStatsConsol t mPns)) + (yearCountFraction DC_ACT_365F d1 d2) + + -- Analytics query + AmountRequiredForTargetIRR irr bondName -> + case getBondByName t True bondName of + Nothing -> Left $ "Failed to find bond by name"++ bondName + Just bnd -> + let + (ds,vs) = L.bondCashflow bnd + valid _vs = case (and ((>0) <$> vs)) of + True -> Left $ "all cashflows are positive"++ show vs + _ -> Right _vs + oDate = L.originDate $ L.bndOriginInfo bnd + in + do + validVs <- valid vs + case A.calcRequiredAmtForIrrAtDate irr ds vs d of + Nothing -> Left $ "Failed to get the required amount for target IRR: "++ bondName++" Rate:"++ show irr + Just amt -> Right $ + if oDate <= d then + toRational amt + else + 0.0 + + CustomData s d -> + case custom t of + Nothing -> Left $ "Date:"++show d++"No Custom data to query" ++ show s + Just mCustom -> + case Map.lookup s mCustom of + Just (CustomConstant v) -> Right . toRational $ v + Just (CustomCurve cv) -> Right . toRational $ getValOnByDate cv d + Just (CustomDS ds) -> queryCompound t d (patchDateToStats d ds ) + _ -> Left $ "Date:"++show d++"Unsupported custom data found for key " ++ show s + + DealStatBalance s -> + case stats t of + (m,_,_,_) -> case Map.lookup s m of + Just v -> Right . toRational $ v + Nothing -> Left $ "Date:"++show d++"Failed to query balance deal stat of -> "++ show s + + _ -> Left ("Date:"++show d++"Failed to query balance formula of -> "++ show s) + + + + +queryDealBool :: P.Asset a => TestDeal a -> DealStats -> Date -> Either String Bool +queryDealBool t@TestDeal{triggers= trgs,bonds = bndMap,fees= feeMap + , liqProvider = liqProviderMap, rateSwap = rateCapMap } + ds + d = + case ds of + TriggersStatus dealcycle tName -> + case trgs of + Just _trgsM -> case Map.lookup dealcycle _trgsM of + Nothing -> Left ("Date:"++show d++"no trigger cycle for this deal" ++ show dealcycle) + Just triggerMatCycle -> + case Map.lookup tName triggerMatCycle of + Nothing -> Left ("Date:"++show d++"no trigger for this deal" ++ show tName ++ " in cycle " ++ show triggerMatCycle) + Just trigger -> Right $ Trg.trgStatus trigger + Nothing -> Left $ "Date:"++show d++"no trigger for this deal" + + IsMostSenior bn bns -> + do + bn1 <- lookupAndApply isPaidOff "Is Most Senior" bn bndMap + bns1 <- lookupAndApplies isPaidOff "Is Most Senior" bns bndMap + return $ + case (bn1, and bns1) of + (False,True) -> True + _ -> False + + IsPaidOff bns -> + do + vs <- lookupAndApplies isPaidOff "Is Paid Off" bns bndMap + return $ and vs -- `debug` ("bond paid off?"++ show vs) + + IsOutstanding bns -> + do + vs <- lookupAndApplies (not . isPaidOff) "Is Outstanding" bns bndMap + return $ and vs + + IsFeePaidOff fns -> + do + vs <- lookupAndApplies isPaidOff "Is Fee Paid Off" fns feeMap + return $ and vs + + IsLiqSupportPaidOff lqNames -> + do + lqs <- lookupAndApplies isPaidOff "Is Liq Support Paid Off" lqNames (fromMaybe Map.empty liqProviderMap) + return $ and lqs + + IsRateSwapPaidOff rsNames -> + do + rps <- lookupAndApplies isPaidOff "Is Swap Paid Off" rsNames (fromMaybe Map.empty rateCapMap) + return $ and rps + + TestRate ds cmp _r -> do + testRate <- queryCompound t d ds + let r = toRational r + return $ case cmp of + G -> testRate > r + GE -> testRate >= r + L -> testRate < r + LE -> testRate <= r + E -> testRate == r + + HasPassedMaturity bns -> do + bMap <- selectInMap "Bond Pass Maturity" bns bndMap + let oustandingBnds = Map.filter (not . isPaidOff) bMap + ms <- sequenceA $ (\bn -> queryCompound t d (MonthsTillMaturity bn)) <$> L.bndName <$> oustandingBnds + return $ all (<= 0) ms + + IsDealStatus st -> Right $ status t == st + + + DealStatBool s -> + case stats t of + (_,_,m,_) -> case Map.lookup s m of + Just v -> Right v + Nothing -> Left $ "Date:"++show d++"Failed to query bool deal stat of -> "++ show s + + + + TestNot ds -> do not <$> (queryDealBool t ds d) + -- TestAny b dss -> b `elem` [ queryDealBool t ds d | ds <- dss ] + TestAny b dss -> anyM (\ x -> (== b) <$> queryDealBool t x d ) dss + TestAll b dss -> allM (\ x -> (== b) <$> queryDealBool t x d ) dss + + _ -> Left ("Date:"++show d++"Failed to query bool type formula"++ show ds) + +-- ^ test a condition with a deal and a date +testPre :: P.Asset a => Date -> TestDeal a -> Pre -> Either String Bool +testPre d t p = + case p of + Types.All pds -> allM (testPre d t) pds + -- Types.Any pds -> return $ any (testPre d t) pds + Types.Any pds -> anyM (testPre d t) pds + IfZero s -> do + q <- queryCompound t d s + return $ (round q) == 0 + + If cmp s amt -> do + q <- (queryCompound t d (ps s)) + return $ toCmp cmp q (toRational amt) -- `debug` (show d++"if cmp "++show (queryDeal t (ps s))++"amt"++show amt) + IfRate cmp s amt -> do + q <- (queryCompound t d (ps s)) + return $ toCmp cmp q (toRational amt) -- `debug` (show d++"rate"++show (queryDealRate t (ps s))++"amt"++show amt) + IfInt cmp s amt -> do + q <- (queryCompound t d (ps s)) + return $ toCmp cmp q (toRational amt) + + -- Integer test + IfIntIn s iset -> do + q <- (queryCompound t d (ps s)) + return $ (round q) `elem` iset + IfIntBetween s rt i1 i2 -> + do + v <- queryCompound t d (ps s) + case rt of + II -> return $ (round v) >= i1 && (round v) <= i2 + IE -> return $ (round v) >= i1 && (round v) < i2 + EI -> return $ (round v) > i1 && (round v) <= i2 + EE -> return $ (round v) > i1 && (round v) < i2 + -- IfIntBetween cmp1 s1 cmp2 s2 amt -> toCmp cmp1 (queryDealInt t (ps s1) d) amt && toCmp cmp2 (queryDealInt t (ps s2) d) amt + IfDate cmp _d -> return $ toCmp cmp d _d + IfDateBetween II d1 d2 -> return $ d >= d1 && (d <= d2) + IfDateBetween EI d1 d2 -> return $ d > d1 && (d <= d2) + IfDateBetween IE d1 d2 -> return $ d >= d1 && (d < d2) + IfDateBetween EE d1 d2 -> return $ d > d1 && (d < d2) + IfDateIn ds -> return $ d `elem` ds + + IfCurve cmp s _ts -> do + q <- (queryCompound t d (ps s)) + return $ toCmp cmp q (getValByDate _ts Inc d) + IfRateCurve cmp s _ts -> do v <- (queryCompound t d (ps s)) + return $ (toCmp cmp) v (getValByDate _ts Inc d) + IfByPeriodCurve cmp sVal sSelect pc -> + do + v <- queryCompound t d (ps sVal) + selector <- queryCompound t d (ps sSelect) + case getValFromPerCurve pc Past Inc (round $ fromRational selector) of + Nothing -> Left $ "Date:"++show d++"Failed to find value from period curve"++ show pc + Just vFromCurve -> + return $ (toCmp cmp) (fromRational v) vFromCurve + + IfRateByPeriodCurve cmp sVal sSelect pc -> + do + v <- queryCompound t d (ps sVal) + selector <- queryCompound t d (ps sSelect) + case getValFromPerCurve pc Past Inc (round $ fromRational selector) of + Nothing -> Left $ "Date:"++show d++"Failed to find value from period curve"++ show pc + Just vFromCurve -> + return $ (toCmp cmp) (fromRational v) vFromCurve + + IfBool s True -> queryDealBool t s d + IfBool s False -> do + q <- (queryDealBool t s d) + return q + If2 cmp s1 s2 -> do + q1 <- (queryCompound t d (ps s1)) + q2 <- (queryCompound t d (ps s2)) + return (toCmp cmp q1 q2) + IfRate2 cmp s1 s2 -> do + q1 <- (queryCompound t d (ps s1)) + q2 <- (queryCompound t d (ps s2)) + return (toCmp cmp q1 q2) + IfInt2 cmp s1 s2 -> do + q1 <- (queryCompound t d (ps s1)) + q2 <- (queryCompound t d (ps s2)) + return (toCmp cmp q1 q2) + IfDealStatus st -> Right $ status t == st -- `debug` ("current date"++show d++">> stutus"++show (status t )++"=="++show st) + + Always b -> Right b + IfNot _p -> not <$> testPre d t _p + where + toCmp x = case x of + G -> (>) + GE -> (>=) + L -> (<) + LE -> (<=) + E -> (==) + ps = patchDateToStats d + +-- ^ convert a condition to string in a deal context +preToStr :: P.Asset a => TestDeal a -> Date -> Pre -> String +preToStr t d p = + case p of + (IfZero ds) -> "0 == " ++ show (fromRational <$> (queryCompound t d (ps ds))) + (If cmp ds bal) -> show (fromRational <$> (queryCompound t d (ps ds))) ++" "++ show cmp ++" " ++show bal + (IfRate cmp ds r) -> show (fromRational <$> (queryCompound t d (ps ds))) ++" "++ show cmp ++" " ++show r + (IfInt cmp ds r) -> show (fromRational <$> (queryCompound t d (ps ds))) ++" "++ show cmp ++" " ++show r + (IfCurve cmp ds ts) -> show (fromRational <$> (queryCompound t d (ps ds))) ++" "++ show cmp ++" " ++show (fromRational (getValByDate ts Inc d)) + (IfDate cmp _d) -> show d ++" "++ show cmp ++" " ++show _d + (IfBool ds b) -> show (fromRational <$> (queryCompound t d ds)) ++" == "++ show b + (If2 cmp ds1 ds2) -> show (fromRational <$> (queryCompound t d (ps ds1))) ++" "++ show cmp ++" " ++show (fromRational <$> (queryCompound t d (ps ds2))) + (IfRate2 cmp ds1 ds2) -> show (fromRational <$> (queryCompound t d (ps ds1))) ++" "++ show cmp ++" " ++show (fromRational <$> (queryCompound t d (ps ds2))) + (IfInt2 cmp ds1 ds2) -> show (fromRational <$> (queryCompound t d (ps ds1))) ++" "++ show cmp ++" " ++show (fromRational <$> (queryCompound t d (ps ds2))) + (IfDealStatus st) -> show (status t) ++" == "++ show st + (IfByPeriodCurve cmp ds1 ds2 pc) + -> let + v = (fromRational <$> queryCompound t d (ps ds1)) + in + case (fromRational <$> queryCompound t d (ps ds2)) of + Left _error -> "Failed to read selector for period curve"++ show ds2 ++ "Error:"++ _error + Right s -> + let + c = getValFromPerCurve pc Past Inc (round s) + in + show v ++" "++ show cmp ++" " ++show c + (IfRateByPeriodCurve cmp ds1 ds2 pc) + -> let + v = (fromRational <$> queryCompound t d (ps ds1)) + in + case queryCompound t d (ps ds2) of + Left _error -> "Failed to read selector for period curve"++ show ds2 ++ "Error:"++ _error + Right s -> + let + c = getValFromPerCurve pc Past Inc (round s) + in + show v ++" "++ show cmp ++" " ++show (fromRational <$> c) + (Always b) -> show b + (IfNot _p) -> "Not "++ preToStr t d _p + (Types.All pds) -> "All:["++ intercalate "|" (map (preToStr t d) pds)++"]" + (Types.Any pds) -> "Any:["++ intercalate "|" (map (preToStr t d) pds)++"]" + _ -> "Failed to read condition"++ show p + + where + 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) diff --git a/src/Deal/DealValidation.hs b/src/Deal/DealValidation.hs new file mode 100644 --- /dev/null +++ b/src/Deal/DealValidation.hs @@ -0,0 +1,521 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} + +module Deal.DealValidation (validateRun,validatePreRun,validateReq) + where + +import Deal.DealBase +import Types +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe + +import qualified Waterfall as W +import qualified CreditEnhancement as CE +import qualified Liability as L +import qualified Accounts as A +import qualified Expense as F +import qualified Asset as P +import qualified Assumptions as AP +import qualified InterestRate as IR + +import Control.Lens hiding (element) +import Control.Lens.TH + +import Data.Maybe +import qualified Assumptions as A + + +import Debug.Trace +debug = flip trace + +validateAction :: [W.Action] -> [ResultComponent] -> Set.Set String -> Set.Set String -> Set.Set String -> Set.Set String-> Set.Set String-> Set.Set String -> Set.Set String -> Set.Set String -> Set.Set String -> Set.Set PoolId -> [ResultComponent] +validateAction [] rs _ _ _ _ _ _ _ _ _ _ = rs +validateAction ((W.Transfer _ acc1 acc2 _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember acc1 accKeys || Set.notMember acc2 accKeys + = validateAction as (rs ++ [ErrorMsg (acc1 ++","++acc2++" not in "++ show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.CalcFee fees):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList fees) feeKeys) + = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayFee _ accName fees _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList fees) feeKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys++" Or "++ show accName ++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.CalcAndPayFee _ accName fees _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList fees) feeKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys++" Or "++ accName ++" not in "++ show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayFeeResidual _ accName feeName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember feeName feeKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (feeName ++ " not in "++ show feeKeys++" Or "++accName++ " not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.CalcBondInt bnds):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayInt _ accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayIntBySeq _ accName bndNames _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bndNames) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bndNames ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.AccrueAndPayIntBySeq _ accName bndNames _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bndNames) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bndNames ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayIntOverIntBySeq _ accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayIntOverInt _ accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.AccrueAndPayInt _ accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayIntResidual _ accName bndName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bndName bndKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (bndName ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrin _ accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinResidual accName bnds):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinWithDue accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinBySeq _ accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinGroup _ accName bg _ _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bg bgNames || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bg++ " not in "++ show bgNames ++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.AccrueAndPayIntGroup _ accName bg _ _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bg bgNames || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bg++ " not in "++ show bgNames ++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayIntGroup _ accName bg _ _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bg bgNames || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bg++ " not in "++ show bgNames ++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.AccrueIntGroup bgs ):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bgs) bgNames) = validateAction as (rs ++ [ErrorMsg (show bgs++ " not in "++ show bgNames)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinResidual accName bnds):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.BuyAsset _ _ accName _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.BuyAssetFrom _ _ accName mRPoolName mPid):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember (fromMaybe PoolConsol mPid) poolKeys = validateAction as (rs ++ [ErrorMsg (show mPid++" not in "++show poolKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinBySeq _ accName bnds _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinGroup _ accName bg _ _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bg bgNames || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bg++ " not in "++ show bgNames ++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.AccrueAndPayIntGroup _ accName bg _ _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bg bgNames || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bg++ " not in "++ show bgNames ++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayIntGroup _ accName bg _ _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bg bgNames || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bg++ " not in "++ show bgNames ++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.AccrueIntGroup bgs ):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bgs) bgNames) = validateAction as (rs ++ [ErrorMsg (show bgs++ " not in "++ show bgNames)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.PayPrinResidual accName bnds):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.BuyAsset _ _ accName _):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.BuyAssetFrom _ _ accName mRPoolName mPid):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember (fromMaybe PoolConsol mPid) poolKeys = validateAction as (rs ++ [ErrorMsg (show mPid++" not in "++show poolKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiquidatePool _ accName mPids):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | isJust mPids && not (Set.isSubsetOf (Set.fromList (fromMaybe [] mPids)) poolKeys) = validateAction as (rs ++ [ErrorMsg (show mPids++" not in "++show poolKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiqSupport _ liqName CE.LiqToAcc [accName]):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys || Set.notMember liqName liqProviderKeys + = validateAction as (rs ++ [ErrorMsg (show accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiqSupport _ liqName CE.LiqToFee feeNames):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList feeNames) feeKeys) || Set.notMember liqName liqProviderKeys + = validateAction as (rs ++ [ErrorMsg (show feeNames++" not in "++show feeKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiqSupport _ liqName CE.LiqToBondInt bndNames):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList bndNames) bndKeys) || Set.notMember liqName liqProviderKeys + = validateAction as (rs ++ [ErrorMsg (show bndNames++" not in "++show bndKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiqRepay _ _ accName liqName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys || Set.notMember liqName liqProviderKeys + = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiqYield _ accName liqName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember accName accKeys || Set.notMember liqName liqProviderKeys + = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiqAccrue liqNames):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList liqNames) liqProviderKeys) + = validateAction as (rs ++ [ErrorMsg (show liqNames ++" not in "++ show liqProviderKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.LiqAccrue liqNames):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | not (Set.isSubsetOf (Set.fromList liqNames) liqProviderKeys) + = validateAction as (rs ++ [ErrorMsg (show liqNames ++" not in "++ show liqProviderKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.SwapAccrue rsName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember rsName rateSwapKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.SwapReceive accName rsName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember rsName rateSwapKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.SwapPay accName rsName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember rsName rateSwapKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.SwapSettle accName rsName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember rsName rateSwapKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.FundWith _ accName bName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bName bndKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (bName ++" not in "++ show bndKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.WriteOff _ bName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember bName bndKeys = validateAction as (rs ++ [ErrorMsg (bName ++" not in "++ show bndKeys )]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.CollectRateCap accName rcName):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | Set.notMember rcName rcKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (rcName ++" not in "++ show rcKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + | otherwise = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.ActionWithPre p subActionList):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + = validateAction (subActionList++as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction ((W.ActionWithPre2 p subActionList1 subActionList2):as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + = validateAction (subActionList1++subActionList2++as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +validateAction (action:as) rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + = validateAction as rs accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys rPoolKeys poolKeys + +extractRequiredRates :: (P.Asset a,IR.UseRate a) => TestDeal a -> Set.Set Types.Index +extractRequiredRates t@TestDeal{accounts = accM + ,fees = feeM + ,bonds = bondM + ,liqProvider = mliqProviderM + ,rateSwap = mrsM + ,rateCap = mRcM + ,pool = pool} + = Set.fromList $ assetIndex ++ accIndex ++ bondIndex ++ liqProviderIndex ++ rsIndex ++ rcIndex + -- = Set.fromList $ accIndex ++ bondIndex ++ liqProviderIndex ++ rsIndex + where + assetIndex = catMaybes $ IR.getIndex <$> getAllAssetList t + + accIndex = catMaybes $ IR.getIndex <$> Map.elems accM + bondIndex = concat $ catMaybes $ IR.getIndexes <$> Map.elems bondM + liqProviderIndex = case mliqProviderM of + Just liqProviderM -> concat $ catMaybes $ IR.getIndexes <$> Map.elems liqProviderM + Nothing -> [] + rsIndex = case mrsM of + Just rsM -> concat $ catMaybes $ IR.getIndexes <$> Map.elems rsM + Nothing -> [] + rcIndex = case mRcM of + Just rcM -> concat $ catMaybes $ IR.getIndexes <$> Map.elems rcM + Nothing -> [] + + -- note fee is not tested +validateAggRule :: [W.CollectionRule] -> [PoolId] -> [ResultComponent] +validateAggRule rules validPids = + [ ErrorMsg ("Pool source "++show ps++" has a weight of "++show r) | ((pid,ps),r) <- Map.toList oustandingPs ] ++ + [ ErrorMsg ("Pool Id not found "++show ospid++" in "++ show validPids) | ospid <- osPid ] + where + countWeight (W.Collect (Just pids) ps _) = Map.fromList [((pid,ps),1.0) | pid <- pids] + countWeight (W.Collect Nothing ps _) = Map.fromList [((PoolConsol,ps),1.0)] + countWeight (W.CollectByPct (Just pids) ps lst) = Map.fromList [((pid,ps), pct) | pid <- pids, pct <- fst <$> lst] + countWeight (W.CollectByPct Nothing ps lst) = Map.fromList [((PoolConsol, ps),pct)| pct <- fst <$> lst] + + sumMap = foldl1 (Map.unionWith (+)) $ countWeight <$> rules + oustandingPs = Map.filter (> 1.0) sumMap + + getPids (W.Collect (Just pids) _ _) = pids + getPids (W.Collect Nothing ps _) = [PoolConsol] + getPids (W.CollectByPct (Just pids) _ _) = pids + getPids (W.CollectByPct Nothing _ _ ) = [PoolConsol] + osPid = Set.elems $ Set.difference (Set.fromList (concat (getPids <$> rules))) (Set.fromList validPids) + + +validateFee :: F.Fee -> [ResultComponent] +-- validateFee (F.Fee fn (F.AnnualRateFee (CurrentBondBalanceOf _) _) _ _ _ _ _ _) = [] +-- validateFee (F.Fee fn (F.AnnualRateFee (OriginalBondBalanceOf _) _) _ _ _ _ _ _) = [] +-- validateFee (F.Fee fn (F.AnnualRateFee (CurrentPoolBalance _) _) _ _ _ _ _ _) = [] +-- validateFee (F.Fee fn (F.AnnualRateFee (OriginalPoolBalance _) _) _ _ _ _ _ _) = [] +-- validateFee (F.Fee fn (F.AnnualRateFee CurrentBondBalance _) _ _ _ _ _ _) = [] +-- validateFee (F.Fee fn (F.AnnualRateFee OriginalBondBalance _) _ _ _ _ _ _) = [] +-- validateFee (F.Fee fn (F.AnnualRateFee ds _) _ _ _ _ _ _ ) +-- = [ErrorMsg ("Fee Name "++fn++" has an unsupported base "++show ds)] +validateFee _ = [] + +--- get required pool id and required revolving pool name +extractRequiredRevolvingPool :: P.Asset a => TestDeal a -> (Set.Set PoolId, Set.Set String) +extractRequiredRevolvingPool t@TestDeal{waterfall = waterfallM} = + let + poolIds = Set.fromList $ getPoolIds t + extract accPoolIds accRpoolNames [] = (accPoolIds,accRpoolNames) + extract accPoolIds accRpoolNames ((W.BuyAsset _ _ _ mPoolId):as) = + extract (Set.insert (fromMaybe PoolConsol mPoolId) accPoolIds) accRpoolNames as + extract accPoolIds accRpoolNames ((W.BuyAssetFrom _ _ _ rPoolName mPoolId):as) = + extract (Set.insert (fromMaybe PoolConsol mPoolId) accPoolIds) + (Set.insert (fromMaybe "Consol" rPoolName) accRpoolNames) + as + extract accPoolIds accRpoolNames ((W.ActionWithPre _ subActions):as) = + let + (subAccPoolIds,subAccRPoolNames) = extract accPoolIds accRpoolNames subActions + in + extract (accPoolIds <> subAccPoolIds) (accRpoolNames <> subAccRPoolNames) as + extract accPoolIds accRpoolNames ((W.ActionWithPre2 _ subActionsA subActionsB):as) = + let + (subAccPoolIdsA,subAccRPoolNamesA) = extract accPoolIds accRpoolNames subActionsA + (subAccPoolIdsB,subAccRPoolNamesB) = extract subAccPoolIdsA subAccRPoolNamesA subActionsB + in + extract subAccPoolIdsB subAccRPoolNamesB as + extract accPoolIds accRpoolNames (_:as) = extract accPoolIds accRpoolNames as + requiredByWaterfall = Map.elems $ Map.map (extract (Set.fromList []) (Set.fromList [])) waterfallM + in + (Set.unions $ fst <$> requiredByWaterfall, Set.unions $ snd <$> requiredByWaterfall) + + +validateReq :: (IR.UseRate a,P.Asset a) => TestDeal a -> AP.NonPerfAssumption -> (Bool,[ResultComponent]) +validateReq t@TestDeal{accounts = accMap, fees = feeMap} + assump@A.NonPerfAssumption{A.interest = intM, A.issueBondSchedule = mIssuePlan, A.revolving = mRevolvingAssump} + = let + ratesRequired = extractRequiredRates t + ratesSupplied = case intM of + Nothing -> Set.empty + Just intLst -> Set.fromList $ [ idx | RateFlat idx _ <- intLst ] ++ [ idx | RateCurve idx _ <- intLst ] + missingIndex = Set.difference ratesRequired ratesSupplied + missingIndexError = if null missingIndex then + [] + else + [ErrorMsg ("Failed to find index "++show missingIndex++"in assumption rates"++ show ratesSupplied)] + + bgNamesInDeal = Map.keysSet $ view dealBondGroups t + -- fee validation + feeErrors = concatMap validateFee $ Map.elems feeMap + -- issue plan validation + issuePlanError = case mIssuePlan of + Nothing -> [] + Just issueBndEventlist + -> let + bgNamesInAssump = Set.fromList $ [ bgName | TsPoint d (A.IssueBondEvent _ bgName _ bnd _ _) <- issueBndEventlist ] + bgNameErrors = [ ErrorMsg ("issueBond:Missing Bond Group Name in Deal:"++ missingBgName ) | missingBgName <- Set.elems (Set.difference bgNamesInAssump bgNamesInDeal)] + + newBndNames = Set.fromList $ [ L.bndName bnd | TsPoint d (A.IssueBondEvent _ _ _ bnd _ _) <- issueBndEventlist ] + existingBndNames = Set.fromList $ L.bndName <$> viewDealAllBonds t + bndNameErrors = [ ErrorMsg ("issueBond:Existing Bond Name in Deal:"++ existsBndName ) | existsBndName <- Set.elems (Set.intersection newBndNames existingBndNames)] + + acNamesInAssump = Set.fromList $ [ acName | TsPoint d (A.IssueBondEvent _ _ acName _ _ _) <- issueBndEventlist ] + existingAccNames = Map.keysSet accMap + accNameErrors = [ ErrorMsg ("issueBond:Missing Account Name in Deal:"++ missingAccName ) | missingAccName <- Set.elems (Set.difference acNamesInAssump existingAccNames)] + + bndNamesInAssump = [ L.bndName bnd | TsPoint d (A.IssueBondEvent _ bgName _ bnd _ _) <- issueBndEventlist ] + bndUniqNames = Set.fromList bndNamesInAssump + dupNamesErrors = [ ErrorMsg("Duplicate Bond Names in Funding Plan") | length bndUniqNames /= length bndNamesInAssump] + in + bgNameErrors ++ accNameErrors ++ bndNameErrors ++ dupNamesErrors + + -- revolving buy validation + revolvingBuyError = let + (requiredPoolIds, requiredRPoolNames) = extractRequiredRevolvingPool t + a = 1 + in + case mRevolvingAssump of + Nothing -> [] + Just (A.AvailableAssets _ _ ) -> [ ErrorMsg ("BuyAsset: Missing Pool Id in assumption" ++ show x) | x <- Set.toList (requiredPoolIds Set.\\ Set.fromList (getPoolIds t))] + Just (A.AvailableAssetsBy rMap ) -> [ ErrorMsg ("BuyAsset: Missing Revolving Pool in assumption" ++ show x) | x <- Set.toList (requiredRPoolNames Set.\\ Set.fromList (Map.keys rMap))] -- `debug` ("requiredRPoolNames 0> "++ show requiredRPoolNames) + + + (dealWarnings,dealErrors) = validatePreRun t + finalErrors = missingIndexError ++ dealErrors ++ issuePlanError ++ feeErrors ++ revolvingBuyError + finalWarnings = dealWarnings + in + (null finalErrors,finalErrors++finalWarnings) + +validatePreRun :: P.Asset a => TestDeal a -> ([ResultComponent],[ResultComponent]) +validatePreRun t@TestDeal{waterfall=waterfallM + ,accounts =accM + ,fees = feeM + ,bonds = bondM + ,collects = aggRule + ,liqProvider = liqProviderM + ,rateSwap = rsM + ,rateCap = rcM + ,triggers = triggerM + ,ledgers = ledgerM + ,pool = pool + ,dates = dates + ,status = status} + = let + accKeys = Map.keysSet accM + bndKeys = Map.keysSet bondM + bgNames = Map.keysSet $ view dealBondGroups t + feeKeys = Map.keysSet feeM + waterfallKeys = Map.keysSet waterfallM + liqProviderKeys = maybe Set.empty Map.keysSet liqProviderM + rateSwapKeys = maybe Set.empty Map.keysSet rsM + rateCapKeys = maybe Set.empty Map.keysSet rcM + ledgerKeys = maybe Set.empty Map.keysSet ledgerM + triggerKeys = maybe Set.empty Map.keysSet triggerM + poolKeys = Set.fromList $ getPoolIds t + rPoolKeys = Set.fromList [] -- $ maybe Set.empty (Set.fromList . Map.keys) pool + poolIds = getPoolIds t + -- date check + + -- issuance balance check + issuanceBalCheck CurrentDates {} = let + stats = Map.elems $ getIssuanceStats t Nothing + lookupResult = Map.lookup IssuanceBalance <$> stats + in + if all isNothing lookupResult then + [ErrorMsg "Issuance balance not found for a Ongoing Deal"] + else + [] + issuanceBalCheck _ = [] + + -- val on deal status and deal dates + + -- collection rule check + aggRuleResult = if isResec t then + [] + else + validateAggRule aggRule poolIds + -- TODO : collectCash shouldn't overlap with others + + -- waterfall key not exists test error + errors = (\x -> validateAction x [] accKeys bndKeys bgNames feeKeys liqProviderKeys rateSwapKeys rateCapKeys ledgerKeys rPoolKeys poolKeys) <$> Map.elems waterfallM + + -- waterfall action coverage check + + -- run result scan + + allErrors = (concat errors) ++ issuanceBalCheck dates ++ aggRuleResult + -- check issuance balance + + w1 = if (not (isPreClosing t)) && (length (Map.elems (getIssuanceStats t Nothing))) == 0 then + [WarningMsg "Deal passes PreClosing status, but not cumulative defaults/delinq at cutoff date?"] + else + [] + warnings = w1 + in + (warnings,allErrors) -- Valiation Pass + +validateRun :: TestDeal a -> [ResultComponent] +validateRun t@TestDeal{waterfall=waterfallM + ,accounts =accM + ,fees = feeM + ,bonds = bondM + ,collects = aggRule + ,liqProvider = liqProviderM + ,rateSwap = rsM + ,triggers = triggerM + ,ledgers = ledgerM} + = let + bndList = viewDealAllBonds t + -- oustanding liability + --- bond + bondWarnings = [ WarningMsg ("Bond "++bn++ " is not paid off") | bn <- L.bndName <$> filter (not . isPaidOff) bndList ] + --- fee + feeWarnings = [ WarningMsg ("Fee "++fn++ " is not paid off") | fn <- Map.elems (Map.map F.feeName $ Map.filter (not . isPaidOff) feeM) ] + --- liquidity provider + liqWarnings = case liqProviderM of + Nothing -> [] + Just liqM -> [ WarningMsg ("LiquidityProvider "++bn++ " is not paid off") | bn <- Map.elems (Map.map CE.liqName $ Map.filter (not . isPaidOff) liqM) ] + --- rate swap + rsWarnings = case rsM of + Nothing -> [] + Just rsM -> [] -- TODO [ WarningMsg ("LiquidityProvider "++bn++ " is not paid off") | bn <- Map.elems (Map.map CE.liqName $ Map.filter (not . isPaidOff) rsM) ] + + -- oustanding assets + --- account + accWarnings = [ WarningMsg ("Account "++an++ " has cash to be distributed") | an <- Map.elems (Map.map A.accName $ Map.filter (\x -> A.accBalance x > 0) accM)] + --- uncollected pool cash + + -- run result scan + in + bondWarnings ++ feeWarnings ++ accWarnings ++ liqWarnings ++ rsWarnings diff --git a/src/Errors.hs b/src/Errors.hs new file mode 100644 --- /dev/null +++ b/src/Errors.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ScopedTypeVariables #-} + + +module Errors(EngineError(..)) + where + + + + +data EngineError = DivideZero + | NoComponentFound + | NotValidAction + deriving (Show,Eq,Ord,Read) diff --git a/src/Expense.hs b/src/Expense.hs new file mode 100644 --- /dev/null +++ b/src/Expense.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module Expense (Fee(..),FeeType(..),payFee,payResidualFee + ,buildFeeAccrueAction + ,feeNameLens,feeDueLens,feeTypeLens,feeStmtLens) + where + +import Lib(Period,paySeqLiabilities,Dates + ,Amount,Balance,Date,Rate,Ts(..)) +import Stmt(appendStmt,Statement,TxnComment(..)) +import Data.Traversable +import Language.Haskell.TH + +import qualified Data.Text +import Data.Aeson hiding (json) +import Data.Aeson.TH +import Data.Aeson.Types +import qualified Data.DList as DL +import GHC.Generics + +import Data.Fixed +import Types +import Util +import DateUtil +import qualified Stmt as S +import qualified InterestRate as IR + +import Control.Lens +import Debug.Trace +debug = flip trace + +type FormulaRate = DealStats + +data FeeType = AnnualRateFee DealStats FormulaRate -- ^ annulized fee with a referece + | PctFee DealStats FormulaRate -- ^ fee base on percentage + | FixFee Balance -- ^ one-off fee + | RecurFee DatePattern Balance -- ^ fee occur every date pattern + | NumFee DatePattern DealStats Amount -- ^ fee based on an integer number + | AmtByTbl DatePattern DealStats (Table Balance Balance) -- ^ lookup query value in a table + | TargetBalanceFee DealStats DealStats -- ^ fee due amount = max( 0, (ds1 - ds2)) + | FeeFlow Ts -- ^ a time series based fee + | FeeFlowByPoolPeriod (PerCurve Balance) -- ^ a pool index series based fee + | FeeFlowByBondPeriod (PerCurve Balance) -- ^ a bond index series based fee + | ByCollectPeriod Amount -- ^ fix amount per collection period + deriving (Show,Eq, Generic,Ord) + +data Fee = Fee { + feeName :: String -- ^ fee name + ,feeType :: FeeType -- ^ fee type + ,feeStart :: Date -- ^ when fee become effective + ,feeDue :: Balance -- ^ outstanding due amount fee + ,feeDueDate :: Maybe Date -- ^ the date when due amount was calculated + ,feeArrears :: Balance -- ^ not paid oustanding amout + ,feeLastPaidDay :: Maybe Date -- ^ last paid date + ,feeStmt :: Maybe Statement -- ^ transaction history +} deriving (Show,Ord, Eq, Generic) + +payFee :: Date -- ^ When pay action happen + -> Amount -- ^ Amount paid to fee + -> Fee -- ^ Fee before being paid + -> Fee -- ^ Fee after paid +payFee d amt f@(Fee fn ft fs fd fdDay fa flpd fstmt) = + f {feeLastPaidDay = Just d ,feeDue = dueRemain ,feeArrears = arrearRemain ,feeStmt = newStmt} + where + [(r0,arrearRemain),(r1,dueRemain)] = paySeqLiabilities amt [fa,fd] + paid = fa + fd - arrearRemain - dueRemain + newStmt = appendStmt (ExpTxn d dueRemain paid arrearRemain (PayFee fn)) fstmt + +-- | pay amount of fee regardless the due amount +payResidualFee :: Date -> Amount -> Fee -> Fee +payResidualFee d amt f@(Fee fn ft fs fd fdDay fa flpd fstmt) = + f {feeLastPaidDay = Just d ,feeDue = dueRemain ,feeArrears = arrearRemain ,feeStmt = newStmt} + where + [(r0,arrearRemain),(r1,dueRemain)] = paySeqLiabilities amt [fa,fd] + newStmt = appendStmt (ExpTxn d dueRemain amt arrearRemain (PayFee fn)) fstmt + +-- | build accure dates for a fee +buildFeeAccrueAction :: [Fee] -> Date -> [(String,Dates)] -> [(String,Dates)] +buildFeeAccrueAction [] ed r = r +buildFeeAccrueAction (fee:fees) ed r = + case fee of + (Fee fn (RecurFee dp _) fs _ _ _ _ _) + -> buildFeeAccrueAction fees ed [(fn, projDatesByPattern dp fs ed)]++r + (Fee fn (FixFee _) fs _ _ _ _ _) + -> buildFeeAccrueAction fees ed [(fn, [fs])]++r + (Fee fn (FeeFlow _ts) _ _ _ _ _ _) + -> buildFeeAccrueAction fees ed [(fn, getTsDates _ts)]++r + (Fee fn (NumFee dp _ _) fs _ _ _ _ _) + -> buildFeeAccrueAction fees ed [(fn, projDatesByPattern dp fs ed)]++r + (Fee fn (AmtByTbl dp _ _) fs _ _ _ _ _) + -> buildFeeAccrueAction fees ed [(fn, projDatesByPattern dp fs ed)]++r + _ + -> buildFeeAccrueAction fees ed r + +instance S.QueryByComment Fee where + queryStmt Fee{feeStmt = Nothing} tc = [] + queryStmt Fee{feeStmt = Just (S.Statement txns)} tc + = filter (\x -> S.getTxnComment x == tc) (DL.toList txns) + +instance Liable Fee where + isPaidOff f@Fee{feeDue=bal,feeArrears=fa} + | bal==0 && fa==0 = True + | otherwise = False + + getOutstandingAmount Fee{feeDue=bal,feeArrears=fa} = bal + fa + +instance IR.UseRate Fee where + isAdjustbleRate x = False + getIndex x = Nothing + +makeLensesFor [("feeName","feeNameLens"),("feeType","feeTypeLens") ,("feeDue","feeDueLens") ,("feeDueDate","feeDueDateLens") ,("feeStmt","feeStmtLens")] ''Fee + +$(deriveJSON defaultOptions ''FeeType) +$(deriveJSON defaultOptions ''Fee) diff --git a/src/Hedge.hs b/src/Hedge.hs new file mode 100644 --- /dev/null +++ b/src/Hedge.hs @@ -0,0 +1,229 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module Hedge + (RateSwap(..),RateCap(..) + ,RateSwapType(..),RateSwapBase(..) + ,accrueIRS,payoutIRS,receiveIRS,receiveRC + ,CurrencySwap(..),rsRefBalLens,SRT(..),SrtType(..) + ) + where + +import qualified Data.Text as T +import qualified Data.Time as Time +import qualified Data.Map as Map +import GHC.Generics +import Language.Haskell.TH +import Data.Aeson hiding (json) +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Fixed +import Data.Maybe +import qualified Data.DList as DL +import Types +import Util +import Stmt +import DateUtil + +import qualified Assumptions as A +import qualified InterestRate as IR +import Control.Lens + +import Debug.Trace +debug = flip trace + +type SettleDates = DatePattern -- ^ dates when rates/ex-rates are reseted +type ReceiveAmount = Balance -- ^ cash to be collect in instrutment +type PayoutAmount = Balance -- ^ cash to be paid in instrutment + +data RateSwapBase = Fixed Balance -- ^ a fixed balance as notional base + | Base DealStats -- ^ a referece as notional base + | Schedule Ts -- ^ a predfiend schedule of notional balance + deriving(Show,Generic,Eq,Ord) + +data RateSwapType = FloatingToFloating Floater Floater -- ^ Paying Floating rate and receiving Floating Rate + | FloatingToFixed Floater IRate -- ^ Paying Floating Rate and receiving Fixed Rate + | FixedToFloating IRate Floater -- ^ Paying Fixed Rate and receiving Floating rate + | FormulaToFloating DealStats Floater -- ^ Paying Formula Rate and receiving Floating rate + | FloatingToFormula Floater DealStats -- ^ Paying Floating Rate and receiving Formula rate + deriving(Show,Generic,Eq,Ord) + +data RateSwap = RateSwap {rsType :: RateSwapType -- ^ swap type + ,rsDayCount :: DayCount -- ^ day count convention + ,rsSettleDates :: Maybe (SettleDates,String) -- ^ define settle dates + ,rsUpdateDates :: DatePattern -- ^ define observe dates + + ,rsNotional :: RateSwapBase -- ^ define notional balance + ,rsRefBalance :: Balance -- ^ notional balance in use + + ,rsPayingRate :: IRate -- ^ collect rate + ,rsReceivingRate :: IRate -- ^ paying rate + + ,rsNetCash :: Balance -- ^ amount to pay/collect + + ,rsStartDate :: StartDate -- ^ swap start date + ,rsLastStlDate :: Maybe Date -- ^ last settle date + ,rsStmt :: Maybe Statement -- ^ transaction history + } + deriving(Show,Generic,Eq,Ord) + +-- | The `accrueIRS` will calculate the `Net` amount +-- ( payble with negative, positve with receivable) of Rate Swap +accrueIRS :: Date -> RateSwap -> RateSwap +accrueIRS d rs@RateSwap{rsRefBalance = face + , rsPayingRate = payRate + , rsReceivingRate = receiveRate + , rsNetCash = netCash + , rsDayCount = dc + , rsStmt = stmt} + = rs {rsNetCash = newNet , rsLastStlDate = Just d, rsStmt = appendStmt newTxn stmt} + where + accureStartDate = case rsLastStlDate rs of + Nothing -> rsStartDate rs + Just lsd -> lsd + rateDiff = receiveRate - payRate + yearFactor = fromRational $ yearCountFraction dc accureStartDate d + newNetAmount = mulBIR (face * yearFactor) rateDiff -- `debug` ("Diff rate"++ show rateDiff) + newNet = netCash + newNetAmount + newTxn = IrsTxn d face newNetAmount payRate receiveRate newNet SwapAccrue + +-- | set rate swap to state of receive all cash from counterparty +receiveIRS :: Date -> RateSwap -> RateSwap +receiveIRS d rs@RateSwap{rsNetCash = receiveAmt, rsStmt = stmt} + | receiveAmt > 0 = rs { rsNetCash = 0 ,rsStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 (SwapInSettle "")) stmt} + | otherwise = rs + +-- | set rate swap to state of payout all possible cash to counterparty +payoutIRS :: Date -> Amount -> RateSwap -> RateSwap +payoutIRS d amt rs@RateSwap{rsNetCash = payoutAmt, rsStmt = stmt} + | payoutAmt < 0 = rs { rsNetCash = outstanding, rsStmt = newStmt } + | otherwise = rs + where + actualAmt = min amt (negate payoutAmt) --TODO need to add a check here + outstanding = payoutAmt + actualAmt + newStmt = appendStmt (IrsTxn d 0 actualAmt 0 0 0 (SwapOutSettle "")) stmt + +instance QueryByComment RateSwap where + queryStmt RateSwap{rsStmt = Nothing} tc = [] + queryStmt RateSwap{rsStmt = Just (Statement txns)} tc + = filter (\x -> getTxnComment x == tc) (DL.toList txns) + +instance Liable RateSwap where + isPaidOff rs@RateSwap{rsNetCash=bal} + | bal == 0 = True + | otherwise = False + + getOutstandingAmount rs@RateSwap{rsNetCash=bal} + | bal < 0 = negate bal + | otherwise = 0 + +data RateCap = RateCap { + rcIndex :: Types.Index + ,rcStrikeRate :: Ts + ,rcNotional :: RateSwapBase + ,rcStartDate :: Date + ,rcSettleDates :: DatePattern + ,rcEndDate :: Date + ,rcReceivingRate :: IRate -- ^ receiving rate + ,rcLastStlDate :: Maybe Date -- ^ last settle date + ,rcNetCash :: Balance -- ^ amount to collect + ,rcStmt :: Maybe Statement -- ^ transaction history + } + deriving(Show,Generic,Eq,Ord) + + +receiveRC :: Date -> RateCap -> RateCap +receiveRC d rc@RateCap{rcNetCash = receiveAmt, rcStmt = stmt} + | receiveAmt > 0 = rc { rcNetCash = 0 ,rcStmt = appendStmt (IrsTxn d 0 receiveAmt 0 0 0 (SwapInSettle "")) stmt} + | otherwise = rc + +instance IR.UseRate RateCap where + getIndexes rc@RateCap{rcIndex = idx} = Just [idx] + +instance QueryByComment RateCap where + queryStmt RateCap{rcStmt = Nothing} tc = [] + queryStmt RateCap{rcStmt = Just (Statement txns)} tc + = filter (\x -> getTxnComment x == tc) (DL.toList txns) + + +data CurrencySwap = CurrencySwap { + csBalance :: Balance + } deriving (Show,Generic,Ord,Eq) + +instance IR.UseRate RateSwap where + getIndexes rs@RateSwap{rsType = rstype} + = case rstype of + FloatingToFloating (idx1,_) (idx2,_) -> Just [idx1,idx2] + FloatingToFixed (idx1,_) _ -> Just [idx1] + FixedToFloating _ (idx1,_) -> Just [idx1] + _ -> Nothing + +makeLensesFor [("rsType","rsTypeLens"),("rsRefBalance","rsRefBalLens")] ''RateSwap + +data SrtType = SrtByEndDay DealStats DatePattern -- ^ autu accrue by end of day + deriving(Show,Generic,Eq,Ord) + + +data SRT = SRT { + srtName :: String + ,srtType :: SrtType + ,srtPremiumType :: IR.RateType -- ^ define how/when to update the balance + + ,srtRefBalance :: Balance -- ^ balance to calc premium + ,srtPremiumRate :: IRate -- ^ current interest rated on oustanding balance + + ,srtOpenBalance :: Balance -- ^ total open balance + + ,srtDuePremiumDate :: Maybe Date -- ^ last day of interest/premium calculated + ,srtDuePremium :: Balance -- ^ oustanding due on premium + + ,srtStart :: Date -- ^ when liquidiy provider came into effective + ,srtEnds :: Maybe Date -- ^ when liquidiy provider came into expired + ,srtStmt :: Maybe Statement -- ^ transaction history +} deriving (Show,Generic,Eq,Ord) + +instance Liable SRT where + isPaidOff srt@SRT{srtOpenBalance=bal,srtDuePremium=duePremium} + | bal==0 && duePremium==0 = True + | otherwise = False + +instance IR.UseRate SRT where + getIndexes srt@SRT{srtPremiumType = rt} + = case rt of + (IR.Floater _ idx _ _ _ _ _ _ ) -> Just [idx] + _ -> Nothing + + getResetDates srt@SRT{srtPremiumType = rt , srtStart = sd, srtEnds = Just ed} + = case rt of + (IR.Floater _ _ _ _ dp _ _ _ ) -> genSerialDatesTill2 EI sd dp ed + _ -> [] + +-- | update the reset events of liquidity provider +buildSrtAccrueAction :: [SRT] -> Date -> [(String, Dates)] -> [(String, Dates)] +buildSrtAccrueAction [] ed r = r +buildSrtAccrueAction (srt:srts) ed r = + case srt of + (SRT srtName (SrtByEndDay _ dp ) _ _ _ _ _ _ ss _ _ ) + -> buildSrtAccrueAction + srts + ed + [(srtName, projDatesByPattern dp ss ed)]++r + _ -> buildSrtAccrueAction srts ed r + +buildSrtResetAction :: [SRT] -> Date -> [(String, Dates)] -> [(String, Dates)] +buildSrtResetAction [] ed r = r +buildSrtResetAction (srt:srts) ed r = + case srt of + srt@SRT{srtPremiumType = rt, srtName = ln , srtStart = sd} -> + buildSrtResetAction + srts + ed + [(ln,IR.getRateResetDates sd ed (Just rt))]++r + _ -> buildSrtResetAction srts ed r + + + + +$(concat <$> traverse (deriveJSON defaultOptions) [''RateSwap, ''RateCap, ''RateSwapType, ''RateSwapBase, ''CurrencySwap]) diff --git a/src/InterestRate.hs b/src/InterestRate.hs new file mode 100644 --- /dev/null +++ b/src/InterestRate.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module InterestRate + (ARM(..),RateType(..),runInterestRate2,runInterestRate,UseRate(..) + ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve + ,getSpread,_getSpread) + + where + +import Language.Haskell.TH +import Data.Aeson hiding (json) +import Data.Aeson.TH +import Data.Maybe +import Data.Fixed +import GHC.Generics +import DateUtil +import Data.Decimal + +import Types +import Util +import Lib + +import Debug.Trace +debug = flip trace + +type InitPeriod = Int +type PeriodicCap = Maybe Spread +type LifetimeCap = Maybe IRate +type PaymentCap = Maybe Balance +type RateFloor = Maybe IRate +type RateCap = Maybe IRate +type InitCap = Maybe IRate +type ResetDates = [Date] +type StartRate = IRate + +data RateType = Fix DayCount IRate + | Floater DayCount Index Spread IRate DatePattern RateFloor RateCap (Maybe (RoundingBy IRate)) + deriving (Show,Generic,Eq,Ord) + +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 + deriving (Show,Generic,Eq,Ord) + +getRateResetDates :: Date -> Date -> Maybe RateType -> Dates +getRateResetDates _ _ Nothing = [] +getRateResetDates _ _ (Just (Fix _ _)) = [] +getRateResetDates sd ed (Just (Floater _ _ _ _ dp _ _ _)) = genSerialDatesTill2 NO_IE sd dp ed + +runInterestRate :: ARM -> StartRate -> RateType -> ResetDates -> Ts -> [IRate] +runInterestRate (ARM ip icap pc lifeCap floor) sr (Floater _ _ spd _ _ _ _ mRoundBy) resetDates rc + = sr:cappedRates + where + fr:rrs = (spd +) . fromRational <$> getValByDates rc Inc resetDates + firstRate + | isNothing icap = fr + | (sr + fromMaybe 0 icap) <= fr = sr + fromMaybe 0 icap + | otherwise = fr + rounder = roundingByM mRoundBy + restRates = tail $ + scanl + (\lastRate idxRate -> + if isNothing pc then -- periodic cap + rounder idxRate + else + if lastRate + (fromMaybe 0 pc) <= idxRate then + rounder $ lastRate + (fromMaybe 0 pc) + else + rounder idxRate) + firstRate + rrs + flooredRates = max (fromMaybe 0 floor) <$> (firstRate:restRates) -- `debug` ("reset rates" ++ show (firstRate:restRates)) + cappedRates = min (fromMaybe 1 lifeCap) <$> flooredRates + +runInterestRate2 :: ARM -> (Date,StartRate) -> RateType -> ResetDates -> Ts -> Ts +runInterestRate2 arm (d,sr) floater resetDates rc + = mkRateTs $ zip (d:resetDates) resultRates -- `debug` ("Result Rate"++show resultRates) + where + resultRates = runInterestRate arm sr floater resetDates rc + +calcIntRate :: Date -> Date -> IRate -> DayCount -> IRate +calcIntRate startDate endDate intRate dayCount = + let + yf = yearCountFraction dayCount startDate endDate + in + intRate * fromRational yf + +calcIntRateCurve :: DayCount -> IRate -> [Date] -> [IRate] +calcIntRateCurve dc r ds + = [ calcIntRate sd ed r dc | (sd,ed) <- zip (init ds) (tail ds) ] + +calcInt :: Balance -> Date -> Date -> IRate -> DayCount -> Amount +calcInt bal startDate endDate intRate dayCount = + let + yfactor = yearCountFraction dayCount startDate endDate + in + mulBR bal (yfactor * toRational intRate) + +class UseRate x where + isAdjustbleRate :: x -> Bool + -- get first index available,if not found return Nothing + getIndex :: x -> Maybe Index + getIndexes :: x -> Maybe [Index] + getResetDates :: x -> Dates + getSpread :: x -> Maybe Spread + + +$(deriveJSON defaultOptions ''ARM) +$(deriveJSON defaultOptions ''RateType) diff --git a/src/Ledger.hs b/src/Ledger.hs new file mode 100644 --- /dev/null +++ b/src/Ledger.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module Ledger (Ledger(..),entryLog,LedgerName,queryGap,clearLedgersBySeq + ,queryDirection,entryLogByDr,bookToTarget) + where +import qualified Data.Time as T +import Stmt +import Types +import Lib +import Util +import Data.Aeson hiding (json) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import qualified Data.DList as DL +import GHC.Generics + +import Control.Lens hiding (element) + +import Control.Lens.TH +import Debug.Trace +debug = flip trace + + +type LedgerName = String + +data Ledger = Ledger { + ledgName :: String -- ^ ledger account name + ,ledgBalance :: Balance -- ^ current balance of ledger + ,ledgStmt :: Maybe Statement -- ^ ledger transaction history +} deriving (Show, Generic,Ord, Eq) + +-- | Book an entry with date,amount and transaction to a ledger +entryLog :: Amount -> Date -> TxnComment -> Ledger -> Ledger +entryLog amt d cmt ledg@Ledger{ledgStmt = mStmt, ledgBalance = bal} + | isTxnDirection Credit cmt = let + newBal = bal - amt + txn = EntryTxn d newBal amt cmt + in + ledg { ledgStmt = appendStmt txn mStmt,ledgBalance = newBal } + | otherwise = let + newBal = bal + amt + txn = EntryTxn d newBal amt cmt + in + ledg { ledgStmt = appendStmt txn mStmt ,ledgBalance = newBal } + +-- TODO-- need to ensure there is no direction in input +entryLogByDr :: BookDirection -> Amount -> Date -> Maybe TxnComment -> Ledger -> Ledger +entryLogByDr dr amt d Nothing = entryLog amt d (TxnDirection dr) +entryLogByDr dr amt d (Just cmt) + | not (hasTxnDirection cmt) = entryLog amt d (TxnComments [TxnDirection dr,cmt]) + | isTxnDirection dr cmt = entryLog amt d cmt + | otherwise = error $ "Suppose direction"++ show dr++"but got from comment"++ show cmt + +entryLogByDr Credit amt d (Just (TxnComments cms)) = entryLog amt d (TxnComments ((TxnDirection Credit):cms)) +entryLogByDr Debit amt d (Just (TxnComments cms)) = entryLog amt d (TxnComments ((TxnDirection Debit):cms)) + +hasTxnDirection :: TxnComment -> Bool +hasTxnDirection (TxnDirection _) = True +hasTxnDirection (TxnComments txns) = any hasTxnDirection txns +hasTxnDirection _ = False + +isTxnDirection :: BookDirection -> TxnComment -> Bool +isTxnDirection Credit (TxnDirection Credit) = True +isTxnDirection Debit (TxnDirection Debit) = True +isTxnDirection Credit (TxnComments txns) = any (isTxnDirection Credit) txns +isTxnDirection Debit (TxnComments txns) = any (isTxnDirection Debit) txns +isTxnDirection _ _ = False + +-- ^ credit is negative amount +queryDirection :: Ledger -> (BookDirection ,Balance) +queryDirection (Ledger _ bal _) + | bal >= 0 = (Debit, bal) + | bal < 0 = (Credit, negate bal) + +bookToTarget :: Ledger -> (BookDirection,Amount) -> (BookDirection,Amount) +bookToTarget Ledger{ledgBalance = bal} (dr, targetBal) + = case (bal > 0, dr) of + (True, Debit) -> + if (targetBal > bal) then + (Debit,targetBal - bal) + else + (Credit,bal - targetBal) + (False, Credit) -> + if (targetBal > abs bal) then + (Credit,targetBal - abs bal) + else + (Debit, abs bal - targetBal) + (True, Credit) -> + (Credit,targetBal + bal) + (False, Debit) -> + (Debit,targetBal + abs bal) + + +-- ^ return ledger's bookable amount (for netting off to zero ) with direction input +queryGap :: BookDirection -> Ledger -> Balance +queryGap dr Ledger{ledgBalance = bal} + = case (bal > 0, dr) of + (True, Debit) -> 0 + (True, Credit) -> bal + (False, Debit) -> negate bal + (False, Credit) -> 0 + +clearLedgersBySeq :: BookDirection -> Date -> Amount -> [Ledger] -> [Ledger] -> ([Ledger],Amount) +clearLedgersBySeq dr d 0 rs unAllocLedgers = (rs++unAllocLedgers,0) +clearLedgersBySeq dr d amtToAlloc rs [] = (rs,amtToAlloc) +clearLedgersBySeq dr d amtToAlloc rs (ledger@Ledger{ledgBalance = bal}:ledgers) + = let + deductAmt = queryGap dr ledger + allocAmt = min deductAmt amtToAlloc + remainAmt = amtToAlloc - allocAmt + newLedger = entryLog allocAmt d (TxnDirection dr) ledger + in + clearLedgersBySeq dr d remainAmt (newLedger:rs) ledgers + +instance QueryByComment Ledger where + queryStmt (Ledger _ _ Nothing) tc = [] + queryStmt (Ledger _ _ (Just (Statement txns))) tc + = filter (\x -> getTxnComment x == tc) (DL.toList txns) + + queryTxnAmt a tc = sum $ map getTxnAmt $ queryStmt a tc + +makeLensesFor [("ledgName","ledgNameLens"),("ledgBalance","ledgBalLens"),("ledgStmt","ledgStmtLens")] ''Ledger + + +$(deriveJSON defaultOptions ''Ledger) diff --git a/src/Liability.hs b/src/Liability.hs new file mode 100644 --- /dev/null +++ b/src/Liability.hs @@ -0,0 +1,752 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE InstanceSigs #-} + +module Liability + (Bond(..),BondType(..),OriginalInfo(..) + ,payInt,payPrin,consolStmt,isPaidOff,getCurBalance + ,priceBond,pv,InterestInfo(..),RateReset(..) + ,getDueInt,weightAverageBalance,calcZspread,payYield,getTotalDueInt + ,buildRateResetDates,isAdjustble,StepUp(..),isStepUp,getDayCountFromInfo + ,calcWalBond,patchBondFactor,fundWith,writeOff,InterestOverInterestType(..) + ,getCurBalance,setBondOrigDate + ,bndOriginInfoLens,bndIntLens,getBeginRate,_Bond,_BondGroup + ,totalFundedBalance,getIndexFromInfo,buildStepUpDates + ,accrueInt,stepUpInterestInfo,payIntByIndex,_MultiIntBond + ,getDueIntAt,getDueIntOverIntAt,getDueIntOverInt,getTotalDueIntAt + ,getCurRate,bondCashflow,getOutstandingAmount,valueBond,getTxnRate + ,getAccrueBegDate,getTxnInt,adjInterestInfoByRate,adjInterestInfoBySpread + ,interestInfoTraversal,getOriginBalance,curRatesTraversal + ,backoutAccruedInt,extractIrrResult,adjustBalance + ) + where + +import Data.Aeson hiding (json) +import Data.Aeson.TH +import Data.Fixed +import qualified Data.Time as T +import Lib (Period(..),Ts(..) ,TsPoint(..) ,daysBetween, weightedBy,paySeqLiabResi) +import Util +import DateUtil +import Types +import Analytics +import Data.Ratio +import Data.Maybe +import Data.List +import qualified Data.Set as Set +import qualified Data.DList as DL +import qualified Stmt as S +import qualified Cashflow as CF +import qualified InterestRate as IR +import qualified Lib +import GHC.Generics +import qualified Data.Map as Map +import Debug.Trace +import InterestRate (UseRate(getIndexes)) +import Language.Haskell.TH +import Control.Lens hiding (Index) +import Control.Lens.TH +import Language.Haskell.TH.Lens +import Stmt (getTxnAmt) +import Numeric.RootFinding + + +debug = flip trace + +-- | test if a bond may changes its interest rate +isAdjustble :: InterestInfo -> Bool +isAdjustble Floater {} = True +isAdjustble RefRate {} = True +isAdjustble Fix {} = False +isAdjustble (CapRate r _ ) = isAdjustble r +isAdjustble (FloorRate r _ ) = isAdjustble r +isAdjustble (WithIoI r _) = isAdjustble r +isAdjustble (RefBal _ r) = isAdjustble r + + +isStepUp :: Bond -> Bool +isStepUp Bond{bndStepUp = Nothing} = False +isStepUp _ = True + +getIndexFromInfo :: InterestInfo -> Maybe [Index] +getIndexFromInfo (Floater _ idx _ _ _ _ _) = Just [idx] +getIndexFromInfo Fix {} = Nothing +getIndexFromInfo RefRate {} = Nothing +getIndexFromInfo (CapRate info _) = getIndexFromInfo info +getIndexFromInfo (FloorRate info _) = getIndexFromInfo info +getIndexFromInfo (WithIoI info _) = getIndexFromInfo info +getIndexFromInfo (RefBal _ info) = getIndexFromInfo info + +getDayCountFromInfo :: InterestInfo -> Maybe DayCount +getDayCountFromInfo (Floater _ _ _ _ dc _ _) = Just dc +getDayCountFromInfo (Fix _ dc) = Just dc +getDayCountFromInfo RefRate {} = Nothing +getDayCountFromInfo (RefBal ds info) = getDayCountFromInfo info +getDayCountFromInfo (CapRate info _) = getDayCountFromInfo info +getDayCountFromInfo (FloorRate info _) = getDayCountFromInfo info +getDayCountFromInfo (WithIoI info _) = getDayCountFromInfo info +getDayCountFromInfo _ = Nothing + +type RateReset = DatePattern + +data InterestOverInterestType = OverCurrRateBy Rational -- ^ inflat ioi rate by pct over current rate + | OverFixSpread Spread -- ^ inflat ioi rate by fix spread + deriving (Show, Eq, Generic, Ord, Read) + + +-- ^ the way how interest due amount is calculated +--------------------------- start Rate, index, spread, reset dates, daycount, floor, cap +data InterestInfo = Floater IRate Index Spread RateReset DayCount (Maybe Floor) (Maybe Cap) + | Fix IRate DayCount -- ^ fixed rate + | RefBal DealStats InterestInfo -- ^ accure interest based on balance(described by a formula) + | RefRate IRate DealStats Float RateReset -- ^ interest rate depends to a formula + | CapRate InterestInfo IRate -- ^ cap rate + | FloorRate InterestInfo IRate -- ^ floor rate + | WithIoI InterestInfo InterestOverInterestType -- ^ Interest Over Interest(normal on left,IoI on right) + deriving (Show, Eq, Generic, Ord, Read) + +-- ^ scale a spread to interest rate info +adjInterestInfoByRate :: Rate -> InterestInfo -> InterestInfo +adjInterestInfoByRate r (Floater a idx s dp dc f c) = Floater (a* fromRational r) idx (s* fromRational r) dp dc f c +adjInterestInfoByRate r (Fix a dc) = Fix (a* fromRational r) dc +adjInterestInfoByRate r (RefRate a ds f dp) = RefRate (a* fromRational r) ds (f* fromRational r) dp +adjInterestInfoByRate r (RefBal ds ii) = RefBal ds (adjInterestInfoByRate r ii) +adjInterestInfoByRate r (CapRate ii a) = CapRate (adjInterestInfoByRate r ii) a +adjInterestInfoByRate r (FloorRate ii a) = FloorRate (adjInterestInfoByRate r ii) a +adjInterestInfoByRate r (WithIoI ii ooi) = WithIoI (adjInterestInfoByRate r ii) ooi + +-- ^ add a spread to interest rate info +adjInterestInfoBySpread :: Spread -> InterestInfo -> InterestInfo +adjInterestInfoBySpread s (Floater a idx s' dp dc f c) = Floater s idx (s+s') dp dc f c +adjInterestInfoBySpread s (Fix a dc) = Fix (a+s) dc +adjInterestInfoBySpread s (RefRate a ds f dp) = RefRate (a+s) ds f dp +adjInterestInfoBySpread s (RefBal ds ii) = RefBal ds (adjInterestInfoBySpread s ii) +adjInterestInfoBySpread s (CapRate ii a) = CapRate (adjInterestInfoBySpread s ii) a +adjInterestInfoBySpread s (FloorRate ii a) = FloorRate (adjInterestInfoBySpread s ii) a +adjInterestInfoBySpread s (WithIoI ii ooi) = WithIoI (adjInterestInfoBySpread s ii) ooi + + +stepUpInterestInfo :: StepUp -> InterestInfo -> InterestInfo +stepUpInterestInfo sp ii = + case ii of + (Floater a idx s dp dc f c) -> Floater a idx (s+getSpread sp) dp dc f c + (Fix r dc) -> Fix (r+getSpread sp) dc + (CapRate ii' r) -> CapRate (stepUpInterestInfo sp ii') r + (FloorRate ii' r) -> FloorRate (stepUpInterestInfo sp ii') r + (WithIoI ii' ooi) -> WithIoI (stepUpInterestInfo sp ii') ooi + (RefBal ds ii') -> RefBal ds (stepUpInterestInfo sp ii') + _ -> ii + where + getSpread (PassDateSpread _ s) = s + getSpread (PassDateLadderSpread _ s _) = s + + +-- ^ get reset dates from interest info +getDpFromIntInfo :: InterestInfo -> Maybe DatePattern +getDpFromIntInfo (Floater _ _ _ dp _ _ _) = Just dp +getDpFromIntInfo (RefRate _ _ _ dp) = Just dp +getDpFromIntInfo (RefBal _ ii) = getDpFromIntInfo ii +getDpFromIntInfo (CapRate ii _) = getDpFromIntInfo ii +getDpFromIntInfo (FloorRate ii _) = getDpFromIntInfo ii +getDpFromIntInfo (WithIoI ii _) = getDpFromIntInfo ii +getDpFromIntInfo _ = Nothing + + +getBeginRate :: InterestInfo -> IRate +getBeginRate (Floater a _ _ _ _ _ _ ) = a +getBeginRate (Fix a _ ) = a +getBeginRate (RefRate a _ _ _ ) = a +getBeginRate (CapRate a _ ) = getBeginRate a +getBeginRate (FloorRate a _ ) = getBeginRate a +getBeginRate (WithIoI a _) = getBeginRate a +getBeginRate (RefBal _ a) = getBeginRate a + + +data StepUp = PassDateSpread Date Spread -- ^ add a spread on a date and effective afterwards + | PassDateLadderSpread Date Spread RateReset -- ^ add a spread on the date pattern + deriving (Show, Eq, Generic, Ord, Read) + + +data OriginalInfo = OriginalInfo { + originBalance::Balance -- ^ issuance balance + ,originDate::Date -- ^ issuance date + ,originRate::Rate -- ^ issuance rate of the bond + ,maturityDate :: Maybe Date -- ^ optional maturity date +} deriving (Show, Eq, Generic, Ord, Read) + + +type PlannedAmorSchedule = Ts +-- ^ the way of principal due is calculated +data BondType = Sequential -- ^ Pass through type tranche + | PAC PlannedAmorSchedule -- ^ bond with schedule amortization + | AmtByPeriod (PerCurve Balance) -- ^ principal due by period + | PacAnchor PlannedAmorSchedule [BondName] -- ^ pay till schdule balance if bonds from bond names has oustanding balance, if other bonds are paid off ,then pay oustanding balance + | Lockout Date -- ^ No principal due till date + | IO + | Z -- ^ Z tranche + | Equity -- ^ Equity type tranche + deriving (Show, Eq, Generic, Ord, Read) + + +-- TODO: for multi int bond, should origin rate be a list of rates? +-- : so far remain orginate rate as a single rate for multi int bond +data Bond = Bond { + bndName :: String + ,bndType :: BondType -- ^ bond type ,which describe the how principal due was calculated + ,bndOriginInfo :: OriginalInfo -- ^ fact data on origination + ,bndInterestInfo :: InterestInfo -- ^ interest info which used to update interest rate + ,bndStepUp :: Maybe StepUp -- ^ step up which update interest rate + -- status + ,bndBalance :: Balance -- ^ current balance + ,bndRate :: IRate -- ^ current rate + ,bndDuePrin :: Balance -- ^ principal due for current period + ,bndDueInt :: Balance -- ^ interest due + ,bndDueIntOverInt :: Balance -- ^ IoI + ,bndDueIntDate :: Maybe Date -- ^ last interest due calc date + ,bndLastIntPay :: Maybe Date -- ^ last interest pay date + ,bndLastPrinPay :: Maybe Date -- ^ last principal pay date + ,bndStmt :: Maybe S.Statement -- ^ transaction history + } + | MultiIntBond { + bndName :: String + ,bndType :: BondType -- ^ bond type ,which describe the how principal due was calculated + ,bndOriginInfo :: OriginalInfo -- ^ fact data on origination + ,bndInterestInfos :: [InterestInfo] -- ^ interest info which used to update interest rate + ,bndStepUps :: Maybe [StepUp] -- ^ step up which update interest rate + -- status + ,bndBalance :: Balance -- ^ current balance + ,bndRates :: [IRate] -- ^ current rate + ,bndDuePrin :: Balance -- ^ principal due for current period + ,bndDueInts :: [Balance] -- ^ interest due + ,bndDueIntOverInts :: [Balance] -- ^ IoI + ,bndDueIntDate :: Maybe Date -- ^ last interest due calc date + ,bndLastIntPays :: Maybe [Date] -- ^ last interest pay date + ,bndLastPrinPay :: Maybe Date -- ^ last principal pay date + ,bndStmt :: Maybe S.Statement -- ^ transaction history + } + | BondGroup (Map.Map String Bond) (Maybe BondType) -- ^ bond group + deriving (Show, Eq, Generic, Ord, Read) + +interestInfoTraversal :: Traversal' Bond InterestInfo +interestInfoTraversal f (Bond bn bt oi ii su bal r dp di dioi did lip lpp stmt) + = (\ii' -> Bond bn bt oi ii' su bal r dp di dioi did lip lpp stmt) <$> f ii +interestInfoTraversal f (MultiIntBond bn bt oi iis sus bal rs dp dis diois did lips lpp stmt) + = (\iis' -> MultiIntBond bn bt oi iis' sus bal rs dp dis diois did lips lpp stmt) <$> traverse f iis +interestInfoTraversal f (BondGroup bMap x) + = BondGroup <$> traverse (interestInfoTraversal f) bMap <*> pure x + +curRatesTraversal :: Traversal' Bond IRate +curRatesTraversal f (Bond bn bt oi ii su bal r dp di dioi did lip lpp stmt) + = (\r' -> Bond bn bt oi ii su bal r' dp di dioi did lip lpp stmt) <$> f r +curRatesTraversal f (MultiIntBond bn bt oi iis sus bal rs dp dis diois did lips lpp stmt) + = (\rs' -> MultiIntBond bn bt oi iis sus bal rs' dp dis diois did lips lpp stmt) <$> traverse f rs +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 + where + getter Bond{bndStmt = mStmt} = mStmt + getter MultiIntBond{bndStmt = mStmt} = mStmt + -- getter BondGroup{bndStmt = mStmt} = mStmt + setter Bond{bndStmt = _} mStmt = Bond{bndStmt = mStmt} + setter MultiIntBond{bndStmt = _} mStmt = MultiIntBond{bndStmt = mStmt} + -- setter BondGroup{bndStmt = _} mStmt = BondGroup{bndStmt = mStmt} + +bondCashflow :: Bond -> ([Date], [Amount]) +bondCashflow b = + let t = S.getAllTxns b + in + (S.getDate <$> t, S.getTxnAmt <$> t) + +-- ^ remove empty transaction frgetBondByName :: Ast.Assetom a bond +consolStmt :: Bond -> Bond +consolStmt (BondGroup bMap x) = BondGroup (consolStmt <$> bMap) x +consolStmt b + | S.hasEmptyTxn b = b + | otherwise = let + txn:txns = S.getAllTxns b + combinedBondTxns = foldl S.consolTxn [txn] txns + droppedTxns = dropWhile S.isEmptyTxn combinedBondTxns + in + b {bndStmt = Just (S.Statement (DL.fromList (reverse droppedTxns)))} + +setBondOrigDate :: Date -> Bond -> Bond +setBondOrigDate d b@Bond{bndOriginInfo = oi} = b {bndOriginInfo = oi{originDate = d}} +setBondOrigDate d b@MultiIntBond{bndOriginInfo = oi} = b {bndOriginInfo = oi{originDate = d}} +setBondOrigDate d (BondGroup bMap x) = BondGroup ((setBondOrigDate d) <$> bMap) $ x + +-- ^ build bond factors +patchBondFactor :: Bond -> Bond +patchBondFactor (BondGroup bMap x) = BondGroup (patchBondFactor <$> bMap) $ x +patchBondFactor bnd + | S.hasEmptyTxn bnd = bnd + | (originBalance (bndOriginInfo bnd)) == 0 = bnd + | otherwise = let + oBal = originBalance (bndOriginInfo bnd) + toFactor (BondTxn d b i p r0 c e f Nothing t) = (BondTxn d b i p r0 c e f (Just (fromRational (divideBB b oBal))) t) + -- newStmt = S.Statement $ toFactor <$> (S.getAllTxns bnd) + newBnd = case bndStmt bnd of + Nothing -> bnd + Just (S.Statement txns) -> bnd {bndStmt = Just (S.Statement (toFactor <$> txns)) } + in + newBnd + +payInt :: Date -> Amount -> Bond -> Bond +-- pay 0 interest, do nothing +payInt d 0 b = b + +-- pay interest +payInt d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) + = bnd {bndDueInt=newDue, bndStmt=newStmt, bndLastIntPay = Just d, bndDueIntOverInt = newDueIoI} + where + rs = Lib.paySeqLiabilitiesAmt amt [dueIoI, dueInt] -- `debug` ("date"++ show d++"due "++show dueIoI++">>"++show dueInt) + newDueIoI = dueIoI - head rs + newDue = dueInt - rs !! 1 -- `debug` ("Avail fund"++ show amt ++" int paid out plan"++ show rs) + newStmt = case bt of + Equity -> S.appendStmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayYield bn)) stmt + _ -> S.appendStmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayInt [bn])) stmt -- `debug` ("date after"++ show d++"due "++show newDueIoI++">>"++show newDue) + +-- pay multi-int bond ,IOI first and then interest due, sequentially +payInt d amt bnd@(MultiIntBond bn bt oi iinfo _ bal rs duePrin dueInts dueIoIs dueIntDate lpayInt lpayPrin stmt) + = bnd {bndDueInts=newDues, bndStmt=newStmt + , bndLastIntPays = Just (replicate l d), bndDueIntOverInts = newDueIoIs} + where + l = length iinfo + ioiPaid = Lib.paySeqLiabilitiesAmt amt dueIoIs + afterIoI = amt - sum ioiPaid + duePaid = Lib.paySeqLiabilitiesAmt afterIoI dueInts + newDueIoIs = zipWith (-) dueIoIs ioiPaid + newDues = zipWith (-) dueInts duePaid + newDueIoI = sum newDueIoIs + newDue = sum newDues + newStmt = case bt of + Equity -> S.appendStmt (BondTxn d bal amt 0 (sum rs) amt newDue newDueIoI Nothing (S.PayYield bn)) stmt + _ -> S.appendStmt (BondTxn d bal amt 0 (sum rs) amt newDue newDueIoI Nothing (S.PayInt [bn])) stmt -- `debug` ("date after"++ show d++"due "++show newDueIoI++">>"++show newDue) + +payIntByIndex :: Date -> Int -> Amount -> Bond -> Bond +-- pay 0 interest, do nothing +payIntByIndex d _ 0 b = b +payIntByIndex d idx amt bnd@(MultiIntBond bn bt oi iinfo _ bal rs duePrin dueInts dueIoIs dueIntDate lpayInt lpayPrin stmt) + = let + dueIoI = dueIoIs !! idx + dueInt = dueInts !! idx -- `debug` ("date"++ show d++"in pay index fun"++ show amt) + [newDueIoI,newDue] = Lib.paySeqLiabResi amt [dueIoI, dueInt] -- `debug` ("date"++ show d++" before pay due "++show dueIoI++">>"++show dueInt) + newStmt = S.appendStmt (BondTxn d bal amt 0 (sum rs) amt newDue newDueIoI Nothing (S.PayInt [bn])) stmt -- `debug` ("date after"++ show d++"due(ioi) "++show newDueIoI++">> due "++show newDue) + od = getOriginDate bnd + ods = replicate (length iinfo) od + in + bnd {bndDueInts = dueInts & ix idx .~ newDue + ,bndDueIntOverInts = dueIoIs & ix idx .~ newDueIoI + ,bndStmt = newStmt + ,bndLastIntPays = case lpayInt of + Nothing -> Just $ ods & ix idx .~ d + Just ds -> Just $ ds & ix idx .~ d} + + +-- ^ pay interest to single bond regardless any interest due +payYield :: Date -> Amount -> Bond -> Bond +payYield d amt bnd@(Bond bn bt oi iinfo _ bal r duePrin dueInt dueIoI dueIntDate lpayInt lpayPrin stmt) + = bnd {bndDueInt = newDue,bndDueIntOverInt=newDueIoI, bndStmt= newStmt} + where + [newDue,newDueIoI] = paySeqLiabResi amt [dueIoI, dueInt] + newStmt = S.appendStmt (BondTxn d bal amt 0 r amt newDue newDueIoI Nothing (S.PayYield bn)) stmt + + +-- ^ pay principal to single bond principal with limit of principal due +payPrin :: Date -> Amount -> Bond -> Bond +-- ^ no cash payment , do nothing +payPrin d 0 bnd = bnd +-- ^ no oustanding balance , do nothing +payPrin d _ bnd@(Bond bn bt oi iinfo _ 0 r 0 0 dueIoI dueIntDate lpayInt lpayPrin stmt) = bnd + +payPrin d amt bnd = bnd {bndDuePrin =newDue, bndBalance = newBal , bndStmt=newStmt} + where + newBal = (bndBalance bnd) - amt + newDue = (bndDuePrin bnd) - amt + bn = bndName bnd + stmt = bndStmt bnd + dueIoI = getDueIntOverInt bnd + dueInt = getDueInt bnd + r = getCurRate bnd + newStmt = S.appendStmt (BondTxn d newBal 0 amt r amt dueInt dueIoI Nothing (S.PayPrin [bn] )) stmt + + +writeOff :: Date -> Amount -> Bond -> Either String Bond +writeOff d 0 b = Right b +writeOff d amt _bnd + | bndBalance _bnd < amt = Left $ "Insufficient balance to write off "++ show amt ++ show " bond name "++ show (bndName _bnd) + | otherwise = + let + bnd = accrueInt d _bnd + newBal = bndBalance bnd - amt + dueIoI = getDueIntOverInt bnd + dueInt = getDueInt bnd + bn = bndName bnd + stmt = bndStmt bnd + newStmt = S.appendStmt (BondTxn d newBal 0 0 0 0 dueInt dueIoI Nothing (S.WriteOff bn amt )) stmt + in + Right $ bnd {bndBalance = newBal , bndStmt=newStmt} + +-- TODO: should increase the original balance of the bond? +fundWith :: Date -> Amount -> Bond -> Bond +fundWith d 0 b = b +fundWith d amt _bnd = bnd {bndBalance = newBal, bndStmt=newStmt } + where + bnd = accrueInt d _bnd + dueIoI = getDueIntOverInt bnd + dueInt = getDueInt bnd + bn = bndName bnd + stmt = bndStmt bnd + newBal = bndBalance bnd + amt + newStmt = S.appendStmt (BondTxn d newBal 0 (negate amt) 0 0 dueInt dueIoI Nothing (S.FundWith bn amt )) stmt + + +-- ^ get interest rate for due interest +getIoI :: InterestInfo -> IRate -> IRate +-- ^ inflate interest rate by pct over current rate +getIoI (WithIoI _ (OverCurrRateBy r)) rate = rate * (1+ fromRational r) +-- ^ inflate interest rate by adding a fix spread +getIoI (WithIoI _ (OverFixSpread r)) rate = rate + r +-- ^ no inflation,just use current bond's rate +getIoI _ rate = rate + +-- ^ accure interest to a bond, update the due interest and due IoI of the bond +accrueInt :: Date -> Bond -> Bond +accrueInt d b@Bond{bndInterestInfo = ii,bndDueIntDate = mDueIntDate, bndDueInt= dueInt + , bndDueIntOverInt = dueIoI, bndRate = r, bndBalance = bal} + | d == beginDate = b + | otherwise = let + dc = (fromMaybe DC_ACT_365F) (getDayCountFromInfo ii) + r2 = getIoI ii r + period = yearCountFraction dc beginDate d + -- newDue = mulBR bal $ toRational r * period + newDue = IR.calcInt bal beginDate d r dc + newIoiDue = mulBR dueInt (toRational r2 * period) + in + b {bndDueInt = newDue+dueInt, bndDueIntOverInt = dueIoI+newIoiDue + ,bndDueIntDate = Just d} + where + beginDate = case mDueIntDate of + Just _d -> _d + Nothing -> getOriginDate b + + +-- accure all the index +accrueInt d b@MultiIntBond{bndInterestInfos = iis, bndDueIntDate = mDueIntDate + , bndDueInts = dueInts, bndDueIntOverInts = dueIoIs + , bndRates = rs, bndBalance = bal} + | beginDate == d = b + | otherwise + = let + l = length iis -- `debug` ("bond Name>>> "++ show (bndName b)) + daycounts = (fromMaybe DC_ACT_365F) . getDayCountFromInfo <$> iis + periods = zipWith3 yearCountFraction daycounts (replicate l beginDate) (repeat d) -- `debug` ((bndName b) ++" date"++ show d++"daycounts"++show daycounts++"beginDates "++show beginDates++ show "end dates"++ show d) + newDues = zipWith3 (\r p due -> (mulBR (mulBIR bal r) p) + due) rs periods dueInts -- `debug` ((bndName b) ++" date"++ show d++"rs"++show rs++"periods "++show periods++">>"++show dueInts) + newIoiDues = zipWith5 (\r p due dueIoI ii -> + (mulBR (mulBIR due (getIoI ii r)) p) + dueIoI) + rs + periods + dueInts + dueIoIs + iis + in + b {bndDueInts = newDues, bndDueIntOverInts = newIoiDues, bndDueIntDate = Just d } + where + l = length iis + beginDate = case mDueIntDate of + Just ds -> ds + Nothing -> getOriginDate b + +accrueInt d (BondGroup bMap x) = BondGroup (accrueInt d <$> bMap) $ x + + +calcWalBond :: Date -> Bond -> Rational +calcWalBond d b@Bond{bndStmt = Nothing} = 0.0 +calcWalBond d b@MultiIntBond{bndStmt = Nothing} = 0.0 +calcWalBond d (BondGroup bMap _) + = let + bndWal = calcWalBond d <$> Map.elems bMap + bndBals = toRational . getCurBalance <$> Map.elems bMap + in + weightedBy bndBals bndWal + +calcWalBond d b + = let + txns = cutBy Exc Future d $ S.getAllTxns b + cutoffBalance = (S.getTxnBegBalance . head ) txns + lastBalance = (S.getTxnBalance . last) txns + firstTxnDate = d + gapDays = (daysBetween firstTxnDate) . S.getDate <$> txns + weightPrins = zipWith (*) (S.getTxnPrincipal <$> txns) (fromIntegral <$> gapDays) + wal = sum weightPrins / 365 / cutoffBalance + in + if lastBalance > 0 then + 0 + else + toRational wal -- `debug` ("WAL-->"++show (bndName b)++">>"++show wal) + + +getTxnRate :: Txn -> IRate +getTxnRate (BondTxn _ _ _ _ r _ _ _ _ _) = r +getTxnRate _ = 0.0 + +getTxnInt :: Txn -> Amount +getTxnInt (BondTxn _ _ _ i _ _ _ _ _ _) = i +getTxnInt _ = 0.0 + + +-- ^ get present value of a bond +priceBond :: Date -> Ts -> Bond -> PriceResult +priceBond d rc b@(Bond _ _ _ _ _ _ _ _ _ _ _ _ _ Nothing ) = PriceResult 0 0 0 0 0 0 [] +priceBond d rc b@(MultiIntBond _ _ _ _ _ _ _ _ _ _ _ _ _ Nothing ) = PriceResult 0 0 0 0 0 0 [] +priceBond d rc bnd + | all (==0) (S.getTxnAmt <$> futureCfs) = PriceResult 0 0 0 0 0 0 [] + | otherwise + = let + presentValue = pv3 rc d (getDate <$> futureCfs) (getTxnAmt <$> futureCfs) + cutoffBalance = case S.getTxnAsOf txns d of + Nothing -> (S.getTxnBegBalance . head) txns + Just _txn -> S.getTxnBegBalance _txn + -- TODO: what if in current deal,no transaction before pricing day ? what's the begin day for interest to accrual? + accruedInt = backoutAccruedInt d (getOriginDate bnd) txns + + wal = calcWalBond d bnd + duration = calcDuration DC_ACT_365F d (zip futureCfDates futureCfFlow) rc + convexity = calcConvexity DC_ACT_365F d (zip futureCfDates futureCfFlow) rc + in + PriceResult presentValue (fromRational (100* (safeDivide' presentValue obal))) (realToFrac wal) (realToFrac duration) (realToFrac convexity) accruedInt futureCfs -- `debug` ("Acc int"++ show accruedInt ) + where + cr = getCurRate bnd + bal = getCurBalance bnd + txns = S.getAllTxns bnd + futureCfs = cutBy Exc Future d txns + futureCfDates = getDate <$> futureCfs + futureCfFlow = getTxnAmt <$> futureCfs + obal = getOriginBalance bnd + od = getOriginDate 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 + (lastTxns, []) -> 0 + ([], x:xs) -> IR.calcInt (S.getTxnBegBalance x) txnStartDate d (getTxnRate x) DC_ACT_365F -- `debug` ("backout Acc 0 "++ show (S.getTxnBegBalance x)++" "++ show txnStartDate++" "++ show d++" "++ show (getTxnRate x)) + (lastTxns, x:xs) -> IR.calcInt (S.getTxnBegBalance x) (getDate (last lastTxns)) d (getTxnRate x) DC_ACT_365F -- `debug` ("backout Acc 1"++ show (S.getTxnBegBalance x)++" "++ show (getDate (last lastTxns))++" "++ show d++" "++ show (getTxnRate x)) + +weightAverageBalance :: Date -> Date -> Bond -> Balance +weightAverageBalance sd ed b@(Bond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ Nothing) + = mulBR currentBalance (yearCountFraction DC_ACT_365F (max bd sd) ed) +weightAverageBalance sd ed b@(MultiIntBond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ Nothing) + = mulBR currentBalance (yearCountFraction DC_ACT_365F (max bd sd) ed) + +weightAverageBalance sd ed b@(Bond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ (Just (S.Statement txns))) + = S.weightAvgBalance' + (max bd sd) + ed + (DL.toList txns) + +weightAverageBalance sd ed b@(MultiIntBond _ _ (OriginalInfo ob bd _ _ ) _ _ currentBalance _ _ _ _ _ _ _ (Just (S.Statement txns))) + = S.weightAvgBalance' + (max bd sd) + ed + (DL.toList txns) + + +weightAverageBalance sd ed bg@(BondGroup bMap _) + = sum $ weightAverageBalance sd ed <$> Map.elems bMap -- `debug` (">>>"++ show (weightAverageBalance sd ed <$> Map.elems bMap)) + + +tryCalcZspread :: Rational -> Balance -> Date -> [(Date,Balance)] -> Ts -> Double -> Double +tryCalcZspread tradePrice originBalance priceDay futureCfs riskFreeCurve spread + = let + pvCurve = shiftTsByAmt riskFreeCurve (fromRational (toRational spread)) + pvs = [ pv pvCurve priceDay _d _amt | (_d, _amt) <- futureCfs ] + newPrice = 100 * sum pvs + faceVal = divideBB newPrice originBalance + in + fromRational (faceVal - tradePrice) + + +calcZspread :: (Rational,Date) -> Bond -> Ts -> Either String Spread +calcZspread _ b@Bond{bndStmt = Nothing} _ = Left "No Cashflow for bond" +calcZspread _ b@MultiIntBond{bndStmt = Nothing} _ = Left "No Cashflow for bond" +calcZspread (tradePrice,priceDay) b riskFreeCurve = + let + txns = S.getAllTxns b + bInfo = bndOriginInfo b + (_,futureTxns) = splitByDate txns priceDay EqToRight + cashflow = S.getTxnAmt <$> futureTxns + ds = S.getDate <$> futureTxns + oBalance = originBalance bInfo + itertimes = 500 + def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.00001 } + in + case ridders def (0.0001,100) (tryCalcZspread tradePrice oBalance priceDay (zip ds cashflow) riskFreeCurve) of + Root r -> Right (fromRational (toRational r)) + _ -> Left $ "Failed to find Z spread with "++ show itertimes ++ " times try" + +-- ^ get total funded balance (from transaction) of a bond +totalFundedBalance :: Bond -> Balance +totalFundedBalance (BondGroup bMap _) = sum $ totalFundedBalance <$> Map.elems bMap +totalFundedBalance b + = let + txns = S.getAllTxns b + isFundingTxn (FundWith _ _) = True + isFundingTxn _ = False + fundingTxns = S.filterTxn isFundingTxn txns + in + sum $ (\(BondTxn d b i p r0 c di dioi f t) -> abs p) <$> fundingTxns + +buildRateResetDates :: Bond -> StartDate -> EndDate -> [Date] +buildRateResetDates (BondGroup bMap _) sd ed = concat $ (\x -> buildRateResetDates x sd ed) <$> Map.elems bMap +buildRateResetDates b@Bond{bndInterestInfo = ii,bndStepUp = mSt } sd ed + = let + resetDp = getDpFromIntInfo ii + floaterRateResetDates (Just dp) = genSerialDatesTill2 NO_IE sd dp ed + floaterRateResetDates Nothing = [] + in + floaterRateResetDates resetDp + +buildRateResetDates b@MultiIntBond{bndInterestInfos = iis} sd ed + = let + floaterRateResetDates (Just dp) = genSerialDatesTill2 NO_IE sd dp ed + floaterRateResetDates Nothing = [] + in + -- TODO: perf: sort and distinct + concat $ (floaterRateResetDates . getDpFromIntInfo) <$> iis + + + +buildStepUpDates :: Bond -> StartDate -> EndDate -> [Date] +buildStepUpDates (BondGroup bMap _) sd ed = concat $ (\x -> buildStepUpDates x sd ed) <$> Map.elems bMap +buildStepUpDates b@Bond{bndStepUp = mSt } sd ed + = case mSt of + Nothing -> [] + Just (PassDateSpread d _) -> [d] + Just (PassDateLadderSpread fstSd _ dp) -> genSerialDatesTill2 IE fstSd dp ed + +buildStepUpDates b@MultiIntBond{bndStepUps = mSt } sd ed + = case mSt of + Nothing -> [] + Just sts -> Set.toList $ + Set.fromList $ + concat $ + (\y -> + case y of + (PassDateLadderSpread fstSd _ dp) -> genSerialDatesTill2 IE fstSd dp ed + (PassDateSpread d _) -> [d] + ) <$> sts + + +instance S.QueryByComment Bond where + queryStmt Bond{bndStmt = Nothing} tc = [] + queryStmt MultiIntBond{bndStmt = Nothing} tc = [] + queryStmt Bond{bndStmt = Just (S.Statement txns)} tc + = Data.List.filter (\x -> S.getTxnComment x == tc) (DL.toList txns) + queryStmt MultiIntBond{bndStmt = Just (S.Statement txns)} tc + = Data.List.filter (\x -> S.getTxnComment x == tc) (DL.toList txns) + +instance Liable Bond where + + isPaidOff b@Bond{bndBalance=bal, bndDueInt=di, bndDueIntOverInt=dioi} + | bal==0 && di==0 && dioi==0 = True + | otherwise = False + isPaidOff MultiIntBond{bndBalance=bal, bndDueInts=dis, bndDueIntOverInts=diois} + | bal==0 && sum dis==0 && sum diois==0 = True + | otherwise = False -- `debug` (bn ++ ":bal"++show bal++"dp"++show dp++"di"++show di) + isPaidOff (BondGroup bMap _) = all (==True) $ isPaidOff <$> Map.elems bMap + + getCurBalance b@Bond {bndBalance = bal } = bal + getCurBalance b@MultiIntBond {bndBalance = bal } = bal + getCurBalance (BondGroup bMap _) = sum $ getCurBalance <$> Map.elems bMap + + getCurRate Bond{bndRate = r} = r + getCurRate MultiIntBond{bndRates = rs} = sum rs + getCurRate (BondGroup bMap _) = + fromRational $ + weightedBy + (toRational . getCurBalance <$> Map.elems bMap) + (toRational . getCurRate <$> Map.elems bMap) + + getOriginBalance (BondGroup bMap _) = sum $ getOriginBalance <$> Map.elems bMap + getOriginBalance b = originBalance $ bndOriginInfo b + + getOriginDate b = originDate $ bndOriginInfo b + + getAccrueBegDate b = case bndDueIntDate b of + Just d -> d + Nothing -> getOriginDate b + + -- ^ get due int of a bond + getDueInt b@Bond{bndDueInt=di} = di + getDueInt MultiIntBond{bndDueInts=dis} = sum dis + getDueInt (BondGroup bMap _) = sum $ getDueInt <$> Map.elems bMap + + getDueIntAt MultiIntBond{bndDueInts=dis} idx = dis !! idx + getDueIntOverIntAt MultiIntBond{bndDueIntOverInts=diois} idx = diois !! idx + getTotalDueIntAt b idx = getDueIntAt b idx + getDueIntOverIntAt b idx + + -- ^ get due IoI of a bond + getDueIntOverInt b@Bond{bndDueIntOverInt=dioi} = dioi + getDueIntOverInt MultiIntBond{bndDueIntOverInts=diois} = sum diois + getDueIntOverInt (BondGroup bMap _) = sum $ getDueIntOverInt <$> Map.elems bMap + + -- ^ get total due interest of a bond (both due int and due IoI) + getTotalDueInt b@Bond{bndDueInt=di,bndDueIntOverInt=dioi} = di + dioi + getTotalDueInt MultiIntBond{bndDueInts=dis,bndDueIntOverInts=diois} = sum dis + sum diois + getTotalDueInt (BondGroup bMap _ ) = sum $ getTotalDueInt <$> Map.elems bMap + + getOutstandingAmount b = getTotalDueInt b + getCurBalance b + +instance IR.UseRate Bond where + isAdjustbleRate :: Bond -> Bool + isAdjustbleRate Bond{bndInterestInfo = iinfo} = isAdjustble iinfo + -- getIndex Bond{bndInterestInfo = iinfo } + getIndexes Bond{bndInterestInfo = iinfo} = getIndexFromInfo iinfo + getIndexes (BondGroup bMap _) = if Data.List.null combined then Nothing else Just combined + where combined = concat . catMaybes $ (\b -> getIndexFromInfo (bndInterestInfo b)) <$> Map.elems bMap + getIndexes MultiIntBond{bndInterestInfos = iis} + = Just $ concat $ concat <$> getIndexFromInfo <$> iis + +-- txnsLens :: Lens' Bond [Txn] +-- txnsLens = bndStmtLens . _Just . S.statementTxns +instance S.HasStmt Bond where + + getAllTxns Bond{bndStmt = Nothing} = [] + getAllTxns Bond{bndStmt = Just (S.Statement txns)} = DL.toList txns + getAllTxns MultiIntBond{bndStmt = Nothing} = [] + getAllTxns MultiIntBond{bndStmt = Just (S.Statement txns)} = DL.toList txns + getAllTxns (BondGroup bMap _) = concat $ S.getAllTxns <$> Map.elems bMap + + hasEmptyTxn Bond{bndStmt = Nothing} = True + hasEmptyTxn Bond{bndStmt = Just (S.Statement txn)} = txn == DL.empty + hasEmptyTxn MultiIntBond{bndStmt = Nothing} = True + hasEmptyTxn MultiIntBond{bndStmt = Just (S.Statement txn)} = txn == DL.empty + hasEmptyTxn (BondGroup bMap _) = all S.hasEmptyTxn $ Map.elems bMap + hasEmptyTxn _ = False + + +makeLensesFor [("bndType","bndTypeLens"),("bndOriginInfo","bndOriginInfoLens"),("bndInterestInfo","bndIntLens"),("bndStmt","bndStmtLens")] ''Bond +makeLensesFor [("bndOriginDate","bndOriginDateLens"),("bndOriginBalance","bndOriginBalanceLens"),("bndOriginRate","bndOriginRateLens")] ''OriginalInfo + +makePrisms ''Bond + +$(deriveJSON defaultOptions ''InterestOverInterestType) +$(deriveJSON defaultOptions ''InterestInfo) +$(deriveJSON defaultOptions ''OriginalInfo) +$(deriveJSON defaultOptions ''BondType) +$(deriveJSON defaultOptions ''StepUp) +$(deriveJSON defaultOptions ''Bond) diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Lib + (Amount,Rate,Dates,Period(..),Balance + ,StartDate,EndDate,daysBetween,daysBetweenI + ,Spread,Date + ,paySeqLiabilities,prorataFactors + ,afterNPeriod,Ts(..),periodsBetween + ,periodRateFromAnnualRate + ,Floor,Cap,TsPoint(..) + ,toDate,toDates,genDates,nextDate + ,getValOnByDate,getIntValOnByDate,sumValTs,subTsBetweenDates,splitTsByDate + ,paySeqLiabilitiesAmt,getIntervalDays,getIntervalFactors + ,zipWith8,zipWith9,zipWith10,zipWith11,zipWith12 + ,weightedBy, mkTs + ,mkRateTs,paySeqLiabResi + ) where + +import qualified Data.Time as T +import qualified Data.Time.Format as TF +import Data.List +-- import qualified Data.Scientific as SCI +import qualified Data.Map as M +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Aeson hiding (json) +import Text.Regex.TDFA +import Data.Fixed (Fixed(..), HasResolution,Centi, resolution) +import Data.Ratio +import Types +import Control.Lens +import Data.List.Lens +import Control.Lens.TH +import Debug.Trace +debug = flip trace + + +periodRateFromAnnualRate :: Period -> IRate -> IRate +periodRateFromAnnualRate Annually annual_rate = annual_rate +periodRateFromAnnualRate Monthly annual_rate = annual_rate / 12 +periodRateFromAnnualRate Quarterly annual_rate = annual_rate / 4 +periodRateFromAnnualRate SemiAnnually annual_rate = annual_rate / 2 +periodRateFromAnnualRate Daily annual_rate = annual_rate / 365 +periodRateFromAnnualRate Weekly annual_rate = annual_rate / 52.143 + +addD :: Date -> T.CalendarDiffDays -> Date +addD d calendarMonth = T.addGregorianDurationClip T.calendarMonth d + +getIntervalDays :: [Date] -> [Int] +getIntervalDays ds = zipWith daysBetweenI (init ds) (tail ds) + +-- get fractional years from a set of dates +getIntervalFactors :: [Date] -> [Rate] +getIntervalFactors ds = (\x -> toRational x / 365) <$> getIntervalDays ds -- `debug` ("Interval Days"++show(ds)) + +-- | +prorataFactors :: [Balance] -> Balance -> [Balance] +prorataFactors bals amt = + case s of + 0.0 -> replicate (length bals) 0.0 + _ -> let + weights = map (\x -> toRational x / s) bals -- `debug` ("bals"++show bals++">>s>>"++show s++"amt to pay"++show amtToPay) + outPut = (\y -> fromRational (y * amtToPay)) <$> weights -- `debug` ("Weights->>"++ show weights) + eps = amt - sum outPut + in + if eps == 0.00 then + outPut + else + over (ix 0) (+ eps) outPut + + where + s = toRational $ sum bals + amtToPay = toRational $ min s (toRational amt) + +-- + +paySeqLiabilities :: Balance -> [Balance] -> [(Balance,Balance)] +paySeqLiabilities startAmt liabilities = + tail $ reverse $ foldl pay [(startAmt, 0)] liabilities + where pay accum@((amt, _):xs) target = + if amt >= target then + (amt-target, 0):accum + else + (0, target-amt):accum + +-- Input: 1000, [100,200,300] -> [100,200,300] +-- Input: 100, [50,80] ->[50,50] +paySeqLiabilitiesAmt :: Balance -> [Balance] -> [Balance] +paySeqLiabilitiesAmt startAmt funds + = zipWith (-) funds remainBals + -- map (\(a,b) -> (a-b)) $ zip funds remainBals + where + remainBals = map snd $ paySeqLiabilities startAmt funds + +paySeqLiabResi :: Amount -> [Balance] -> [Amount] +paySeqLiabResi startAmt funds + = zipWith (-) funds allocatedAmts + where + allocatedAmts = paySeqLiabilitiesAmt startAmt funds + +afterNPeriod :: T.Day -> Integer -> Period -> T.Day +afterNPeriod d i p = + T.addGregorianMonthsClip ( months * i) d + where + months = case p of + Monthly -> 1 + Quarterly -> 3 + SemiAnnually -> 6 + Annually -> 12 + +periodsBetween :: T.Day -> T.Day -> Period -> Integer +periodsBetween t1 t2 p + = case p of + Weekly -> div (T.diffDays t1 t2) 7 + Monthly -> _diff + Annually -> div _diff 12 + Quarterly -> div _diff 4 + where + _diff = T.cdMonths $ T.diffGregorianDurationClip t1 t2 + + +mkTs :: [(Date,Rational)] -> Ts +mkTs [] = FloatCurve [] +mkTs ps = FloatCurve [ TsPoint d v | (d,v) <- ps] + + +mkRateTs :: [(Date,IRate)] -> Ts +mkRateTs ps = IRateCurve [ TsPoint d v | (d,v) <- ps] + + +getValOnByDate :: Ts -> Date -> Balance +getValOnByDate (BalanceCurve dps) d + = case find (\(TsPoint _d _) -> ( d >= _d )) (reverse dps) of + Just (TsPoint _d v) -> v + Nothing -> 0 + +getIntValOnByDate :: Ts -> Date -> Int +getIntValOnByDate (IntCurve dps) d + = case find (\(TsPoint _d _) -> ( d >= _d )) (reverse dps) of + Just (TsPoint _d v) -> v + Nothing -> 0 + + +splitTsByDate :: Ts -> T.Day -> (Ts, Ts) +splitTsByDate (BalanceCurve ds) d + = case (findIndex (\(TsPoint _d _) -> _d > d ) ds) of + Nothing -> (BalanceCurve ds, BalanceCurve []) + Just idx -> (BalanceCurve l, BalanceCurve r) + where + (l,r) = splitAt idx ds + +subTsBetweenDates :: Ts -> Maybe Date -> Maybe Date -> Ts +subTsBetweenDates (BalanceCurve vs) (Just sd) (Just ed) + = BalanceCurve $ filter(\(TsPoint x _) -> (x > sd) && (x < ed) ) vs +subTsBetweenDates (BalanceCurve vs) Nothing (Just ed) + = BalanceCurve $ filter(\(TsPoint x _) -> x < ed ) vs +subTsBetweenDates (BalanceCurve vs) (Just sd) Nothing + = BalanceCurve $ filter(\(TsPoint x _) -> x > sd ) vs + +sumValTs :: Ts -> Amount +sumValTs (BalanceCurve ds) = foldr (\(TsPoint _ v) acc -> acc+v ) 0 ds + + +toDate :: String -> Date +toDate = TF.parseTimeOrError True TF.defaultTimeLocale "%Y%m%d" + +toDates :: [String] -> [Date] +toDates ds = toDate <$> ds + +zipWith8 :: (a->b->c->d->e->f->g->h->i) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i] +zipWith8 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) + = z a b c d e f g h : zipWith8 z as bs cs ds es fs gs hs +zipWith8 _ _ _ _ _ _ _ _ _ = [] + +zipWith9 :: (a->b->c->d->e->f->g->h->i->j) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j] +zipWith9 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) (j:js) + = z a b c d e f g h j : zipWith9 z as bs cs ds es fs gs hs js +zipWith9 _ _ _ _ _ _ _ _ _ _ = [] + +zipWith10 :: (a->b->c->d->e->f->g->h->i->j->k) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j]->[k] +zipWith10 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) (j:js) (k:ks) + = z a b c d e f g h j k: zipWith10 z as bs cs ds es fs gs hs js ks +zipWith10 _ _ _ _ _ _ _ _ _ _ _ = [] + +zipWith11 :: (a->b->c->d->e->f->g->h->i->j->k->l) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j]->[k]->[l] +zipWith11 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) (j:js) (k:ks) (l:ls) + = z a b c d e f g h j k l: zipWith11 z as bs cs ds es fs gs hs js ks ls +zipWith11 _ _ _ _ _ _ _ _ _ _ _ _ = [] + +zipWith12 :: (a->b->c->d->e->f->g->h->i->j->k->l->m) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j]->[k]->[l]->[m] +zipWith12 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) (j:js) (k:ks) (l:ls) (m:ms) + = z a b c d e f g h j k l m: zipWith12 z as bs cs ds es fs gs hs js ks ls ms +zipWith12 _ _ _ _ _ _ _ _ _ _ _ _ _ = [] + + +floatToFixed :: HasResolution a => Float -> Fixed a +floatToFixed x = y where + y = MkFixed (round (fromInteger (resolution y) * x)) + +-- | given balances and weight, get sum weighted balance +weightedBy :: [Rational] -> [Rational] -> Rational +weightedBy ws vs + | sum_weights == 0 = 0 + | otherwise = sum ( zipWith (*) vs ws ) / sum_weights + where + sum_weights = sum ws + +-- | Given a start date and a end date, return number of days between(Integer) +daysBetween :: Date -> Date -> Integer +daysBetween sd ed = fromIntegral (T.diffDays ed sd) + +-- | Given a start date and a end date, return number of days between(Int) +daysBetweenI :: Date -> Date -> Int +daysBetweenI sd ed = fromInteger $ T.diffDays ed sd + +genDates :: Date -> Period -> Int -> [Date] +genDates start_day BiWeekly n = + [ T.addGregorianDurationClip (T.CalendarDiffDays 0 (toInteger i * 14)) start_day | i <- [1..n]] --`debug` ("Hit weekly") +genDates start_day Weekly n = + [ T.addGregorianDurationClip (T.CalendarDiffDays 0 (toInteger i * 7)) start_day | i <- [1..n]] --`debug` ("Hit weekly") +genDates start_day p n = + [ T.addGregorianDurationClip (T.CalendarDiffDays (toInteger i*mul) 0) start_day | i <- [1..n]] + where + mul = case p of + Monthly -> 1 + Quarterly -> 3 + SemiAnnually -> 6 + Annually -> 12 + _ -> error $ "Invalid period" ++ show p + +nextDate :: Date -> Period -> Date +nextDate d p + = T.addGregorianMonthsClip m d + where + m = case p of + Monthly -> 1 + Quarterly -> 3 + SemiAnnually -> 6 + Annually -> 12 + _ -> 0 diff --git a/src/Pool.hs b/src/Pool.hs new file mode 100644 --- /dev/null +++ b/src/Pool.hs @@ -0,0 +1,196 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module Pool (Pool(..),aggPool + ,getIssuanceField + ,poolFutureCf,poolIssuanceStat + ,poolFutureScheduleCf + ,poolBegStats,calcLiquidationAmount,pricingPoolFlow + ,futureScheduleCfLens,futureCfLens, poolFutureCf +) where + + +import Lib (Period(..) + ,Ts(..),periodRateFromAnnualRate,toDate + ,getIntervalDays,zipWith9,mkTs,periodsBetween + ,mkRateTs,daysBetween, ) + +import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) +import qualified Assumptions as A +import qualified Analytics as AN +import qualified AssetClass.AssetBase as ACM +import AssetClass.AssetCashflow +import Asset (Asset(..)) +import qualified Data.Map as Map + +import Data.Ratio +import Data.Aeson hiding (json) +import Language.Haskell.TH +import GHC.Generics +import Data.Aeson.TH +import Data.Aeson.Types +import Types hiding (Current) + +import Data.Maybe +import Control.Lens +import Control.Lens.TH +import Assumptions (ApplyAssumptionType) + +import Util +import Cashflow (CashFlowFrame) +import qualified Stmt as CF +import Debug.Trace +debug = flip trace + + +data Pool a = Pool {assets :: [a] -- ^ a list of assets in the pool + ,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.PoolCashflow) +poolFutureCf = lens getter setter + where + getter = futureCf + setter p mNewCf = p {futureCf = mNewCf} + +poolFutureScheduleCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow) +poolFutureScheduleCf = lens getter setter + where + getter = futureScheduleCf + setter p mNewCf = p {futureScheduleCf = mNewCf} + +poolIssuanceStat :: Asset a => Lens' (Pool a) (Map.Map CutoffFields Balance) +poolIssuanceStat = lens getter setter + where + getter p = fromMaybe Map.empty $ issuanceStat p + setter p m = case issuanceStat p of + Nothing -> p {issuanceStat = Just m} + Just _ -> p {issuanceStat = Just m} + + +-- | get stats of pool +getIssuanceField :: Pool a -> CutoffFields -> Either String Balance +getIssuanceField p@Pool{issuanceStat = Just m} s + = case Map.lookup s m of + Just r -> Right r + Nothing -> Left $ "Faile dto find field "++ show s ++ "in pool issuance " ++ show m +getIssuanceField Pool{issuanceStat = Nothing} s + = Left $ "There is no pool stats to lookup:" ++ show s + +poolBegStats :: Pool a -> (Balance,Balance,Balance,Balance,Balance,Balance) +poolBegStats p = + let + m = issuanceStat p + stats = case m of + Nothing -> (0,0,0,0,0,0) + Just m -> (Map.findWithDefault 0 HistoryPrincipal m + ,Map.findWithDefault 0 HistoryPrepayment m + ,Map.findWithDefault 0 HistoryDelinquency m + ,Map.findWithDefault 0 HistoryDefaults m + ,Map.findWithDefault 0 HistoryRecoveries m + ,Map.findWithDefault 0 HistoryLoss m) + in + stats + + +-- | Aggregate all cashflow into a single cashflow frame +-- patch with pool level cumulative defaults/loss etc +aggPool :: Maybe (Map.Map CutoffFields Balance) -> [(CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> (CF.CashFlowFrame, Map.Map CutoffFields Balance) +aggPool Nothing [] = (CF.CashFlowFrame (0,toDate "19000101",Nothing) [],Map.empty) +aggPool (Just m) [] = (CF.CashFlowFrame (0,toDate "19000101",Nothing) [], m) +aggPool mStat xs + = let + cfs = fst <$> xs + CF.CashFlowFrame st _txns = foldr1 CF.combine cfs + -- total stats with begin stats + stats from each cfs + stats = foldr1 (Map.unionWith (+)) $ fromMaybe Map.empty mStat:(snd <$> xs) + -- patch cumulative statistics + cumulativeStatAtCutoff = case mStat of + Nothing -> (0,0,0,0,0,0) + Just m -> (Map.findWithDefault 0 HistoryPrincipal m + ,Map.findWithDefault 0 HistoryPrepayment m + ,Map.findWithDefault 0 HistoryDelinquency m + ,Map.findWithDefault 0 HistoryDefaults m + ,Map.findWithDefault 0 HistoryRecoveries m + ,Map.findWithDefault 0 HistoryLoss m) + -- (CumPrincipal,CumPrepay,CumDelinq,CumDefault,CumRecovery,CumLoss) + txns = CF.patchCumulative cumulativeStatAtCutoff [] _txns + -- txns = CF.patchCumulativeAtInit (Just cumulativeStatAtCutoff) _txns + in + case Map.lookup AccruedInterest =<< mStat of + Nothing -> (CF.CashFlowFrame st txns, stats) + Just accruedIntAmt -> (CF.CashFlowFrame st (CF.clawbackInt accruedIntAmt txns), stats) + + +calcLiquidationAmount :: Asset a => PricingMethod -> Pool a -> Date -> Amount +calcLiquidationAmount (BalanceFactor currentFactor defaultFactor ) pool d + = case futureCf pool of + 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 + in + case earlierTxns of + [] -> 0 -- `debug` ("No pool Inflow") + _ -> (mulBR (view CF.tsRowBalance (last earlierTxns)) currentFactor) + (mulBR currentCumulativeDefaultBal defaultFactor) + -- TODO need to check if missing last row + + +-- TODO: check futureCf is future CF or not, seems it is collected CF +-- | 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 + = case futureCf pool of + 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) + pvCf = sum $ map (\x -> AN.pv2 discountRate d (CF.getDate x) (CF.tsTotalCash x)) futureTxns -- `debug` ("FutureTxns: "++show futureTxns) + + currentDefaulBal = sum $ map (\x -> CF.mflowDefault x - CF.mflowRecovery x - CF.mflowLoss x) earlierTxns + in + + pvCf + mulBR currentDefaulBal recoveryPct + +-- ^ price a pool with collected cashflow and future cashflow +pricingPoolFlow :: Asset a => Date -> Pool a -> CF.PoolCashflow -> PricingMethod -> Amount +pricingPoolFlow d pool@Pool{ futureCf = Just (mCollectedCf,_), issuanceStat = mStat } (futureCfUncollected,_) pm + = let + 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 + + in + case pm of + BalanceFactor currentFactor defaultFactor -> + mulBR currentPerformingBal currentFactor + mulBR currentCumulativeDefaultBal defaultFactor + + PvRate discountRate -> + let + futureTxn = view CF.cashflowTxn futureCfUncollected -- `debug` ("PV with cf"++ show d ++ ">>"++show futureCfUncollected) + futureCfCash = CF.tsTotalCash <$> futureTxn + futureDates = getDate <$> futureTxn + in + AN.pv21 discountRate d futureDates futureCfCash + + + + +$(deriveJSON defaultOptions ''Pool) diff --git a/src/Reports.hs b/src/Reports.hs new file mode 100644 --- /dev/null +++ b/src/Reports.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} + +module Reports (patchFinancialReports,getItemBalance,buildBalanceSheet,buildCashReport + ) where + +import Data.List ( find, sort ) +import qualified Data.DList as DL +import qualified Asset as P +import qualified Data.Map as Map +import qualified Cashflow as CF +import qualified Accounts as A +import qualified CreditEnhancement as CE +import qualified Hedge as HE +import qualified Expense as F +import qualified Liability as L +import Control.Applicative (liftA3) +import Types +import Deal.DealBase + ( TestDeal(TestDeal, pool, fees, bonds, accounts,liqProvider,rateSwap), getIssuanceStatsConsol, getAllCollectedFrame ,poolTypePool, dealPool) +import Deal.DealQuery ( queryCompound ) +import Deal.DealAction ( calcDueFee, calcDueInt ) +import Data.Maybe (fromMaybe) + +import Control.Lens hiding (element) +import Control.Lens.TH +import Control.Lens +import Stmt + ( aggByTxnComment, + getFlow, + getTxnComment, + getTxns, + FlowDirection(Outflow, Inflow) ) + +-- ^ add financial report to the logs +patchFinancialReports :: P.Asset a => TestDeal a -> Date -> DL.DList ResultComponent -> Either String (DL.DList ResultComponent) +-- patchFinancialReports t d DL.empty = return (DL.empty) +patchFinancialReports t d logs + = case (find pickReportLog (reverse (DL.toList logs))) of + Nothing -> Right logs + Just (FinancialReport sd ed bs cash) + -> let + cashReport = buildCashReport t ed d + in + do + bsReport <- buildBalanceSheet t d + let newlog = FinancialReport ed d bsReport cashReport + return (DL.snoc logs newlog) + where + pickReportLog FinancialReport {} = True + pickReportLog _ = False + +getItemBalance :: BookItem -> Balance +getItemBalance (Item _ bal) = bal +getItemBalance (ParentItem _ items) = sum $ getItemBalance <$> items + +getPoolBalanceStats :: P.Asset a => TestDeal a -> Date -> Maybe [PoolId] -> Either String [Balance] +getPoolBalanceStats t d mPid + = let + poolStats = [queryCompound t d (FutureCurrentPoolBalance mPid) + ,(queryCompound t d (PoolCumCollection [NewDefaults] mPid)) + ,negate <$> (queryCompound t d (PoolCumCollection [CollectedRecoveries] mPid))] + in + do + poolStats2::[Rational] <- sequenceA poolStats + return $ fromRational <$> poolStats2 + + + + + +type PoolBalanceSnapshot = (Balance, Balance, Balance) + +buildBalanceSheet :: P.Asset a => TestDeal a -> Date -> Either String BalanceSheetReport +buildBalanceSheet t@TestDeal{ pool = pool, bonds = bndMap , fees = feeMap , liqProvider = liqMap, rateSwap = rsMap ,accounts = accMap} + d + = let + --- accounts + accM = [ ParentItem accName [Item "Balance" accBal,Item "Accrue Int" accDue] | (accName, [accBal,accDue]) <- Map.toList $ Map.map (\acc -> [A.accBalance,(A.accrueInt d)] <*> [acc]) accMap ] + -- accsDueMap = [ Item accName accAccrueBal | (accName, accAccrueBal) <- Map.toList $ Map.map (A.accrueInt d) accMap ] + + ---- pools + mapPoolKey PoolConsol = Nothing + mapPoolKey (PoolName x) = Just [PoolName x] + poolAstBalMap_ = Map.mapWithKey + (\k _ -> getPoolBalanceStats t d (mapPoolKey k)) $ + view (dealPool . poolTypePool) t + + ---- swaps + swapToCollect = ParentItem "Swap" [ ParentItem rsName [ Item "To Receive" rsNet ] | (rsName,rsNet) <- Map.toList (Map.map (HE.rsNetCash . (HE.accrueIRS d)) (fromMaybe Map.empty rsMap)) + , rsNet > 0 ] + + -- liquidity provider + liqProviderAccrued = Map.map (CE.accrueLiqProvider d) (fromMaybe Map.empty liqMap) + liqProviderOs = [ ParentItem liqName [Item "Balance" liqBal,Item "Accrue Int" liqDueInt, Item "Due Fee" liqDueFee ] | (liqName,[liqBal,liqDueInt,liqDueFee]) <- Map.toList (Map.map (\liq -> [CE.liqBalance,CE.liqDueInt,CE.liqDuePremium]<*> [liq]) liqProviderAccrued)] + -- rate swap + swapToPay = ParentItem "Swap" [ ParentItem rsName [Item "To Pay" (negate rsNet)] | (rsName,rsNet) <- Map.toList (Map.map (HE.rsNetCash . (HE.accrueIRS d)) (fromMaybe Map.empty rsMap)) + , rsNet < 0 ] + + in + do + poolAstBalMap <- sequenceA poolAstBalMap_ + let poolAstMap = Map.mapWithKey + (\k vs -> ParentItem (show k) + [ Item "Performing" (vs!!0) + , Item "Defaulted" (vs!!1) + , Item "Recovery" (vs!!2) ]) + poolAstBalMap + let poolAst = ParentItem "Pool" $ Map.elems poolAstMap + -- Asset : Account, pool, swap to collect + let ast = ParentItem "Asset" [ParentItem "Account" accM , poolAst , swapToCollect] + feeWithDueAmount <- (F.feeDue <$>) <$> mapM ((calcDueFee t d)) feeMap + let feeToPay = ParentItem "Fee" [ ParentItem feeName [Item "Due" feeDueBal] + | (feeName,feeDueBal) <- Map.toList feeWithDueAmount ] + bndWithDueAmount <- mapM (calcDueInt t d) bndMap + let bndToShow = Map.map (\bnd -> (L.getCurBalance bnd, L.getTotalDueInt bnd)) bndWithDueAmount + let bndM = [ ParentItem bndName [Item "Balance" bndBal,Item "Due Int" bndDueAmt ] + | (bndName,(bndBal,bndDueAmt)) <- Map.toList bndToShow] + -- Liabilities: bond, fee, liquidity, swap to pay + let liab = ParentItem "Liability" [ ParentItem "Bond" bndM , feeToPay, ParentItem "Liquidity" liqProviderOs, swapToPay] + let totalDebtBal = getItemBalance liab + let totalAssetBal = getItemBalance ast + let eqty = Item "Net Asset" (totalAssetBal - totalDebtBal) + return $ BalanceSheetReport {asset=ast,liability=liab,equity=eqty,reportDate=d} + +-- TODO performance improve here, need to filter txn first +buildCashReport :: P.Asset a => TestDeal a -> Date -> Date -> CashflowReport +buildCashReport t@TestDeal{accounts = accs} sd ed + = CashflowReport { inflow = inflowItems + , outflow = outflowItems + , net = cashChange + , startDate = sd + , endDate = ed } + where + _txns = concat $ Map.elems $ Map.map (DL.toList . getTxns) $ Map.map A.accStmt accs + txns = sliceBy EI sd ed _txns + + inflowTxn = sort $ filter (\x -> (getFlow . getTxnComment) x == Inflow) txns + outflowTxn = sort $ filter (\x -> (getFlow . getTxnComment) x == Outflow) txns + + inflowM = Map.mapKeys show $ aggByTxnComment inflowTxn Map.empty + outflowM = Map.mapKeys show $ aggByTxnComment outflowTxn Map.empty + + inflowItems = ParentItem "Inflow" [ Item k v | (k,v) <- Map.toList inflowM ] + outflowItems = ParentItem "Outflow" [ Item k v | (k,v) <- Map.toList outflowM ] + + cashChange = Item "Net Cash" $ sum (Map.elems inflowM) + sum (Map.elems outflowM) diff --git a/src/Revolving.hs b/src/Revolving.hs new file mode 100644 --- /dev/null +++ b/src/Revolving.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} + + +module Revolving + ( RevolvingPool(..) + , lookupAssetAvailable + ) + where + +import GHC.Generics +import Language.Haskell.TH +import Data.Aeson hiding (json) +import qualified Data.Text as T +import qualified Cashflow as CF +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Hashable +import Data.Fixed +import Data.List +import Types + +import AssetClass.AssetBase + + +data RevolvingPool = ConstantAsset [AssetUnion] -- ^ Assets in revolving pool stays constant after being bought + | StaticAsset [AssetUnion] -- ^ Assets in revolving pool will decrease afeter being bought + | AssetCurve [TsPoint [AssetUnion]] -- ^ Assets are changing by dates + deriving (Show,Generic) + + +lookupAssetAvailable :: RevolvingPool -> Date -> [AssetUnion] +lookupAssetAvailable (ConstantAsset aus) _ = aus +lookupAssetAvailable (StaticAsset aus) _ = aus +lookupAssetAvailable (AssetCurve ausCurve) d + = case find (\(TsPoint _d _) -> d > _d) (reverse ausCurve) of + Just (TsPoint _d v) -> v + Nothing -> [] + + + +$(deriveJSON defaultOptions ''RevolvingPool) diff --git a/src/Stmt.hs b/src/Stmt.hs new file mode 100644 --- /dev/null +++ b/src/Stmt.hs @@ -0,0 +1,297 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE InstanceSigs #-} + +module Stmt + (Statement(..) + ,getTxns,getTxnComment,getTxnAmt,toDate,getTxnPrincipal,getTxnAsOf,getTxnBalance + ,appendStmt,combineTxn,getTxnBegBalance,getDate,getDates + ,TxnComment(..),QueryByComment(..) + ,weightAvgBalanceByDates,weightAvgBalance,weightAvgBalance',sumTxn, consolTxn + ,getFlow,FlowDirection(..), aggByTxnComment,scaleByFactor + ,scaleTxn,isEmptyTxn, statementTxns, viewBalanceAsOf,filterTxn + ,HasStmt(..),Txn(..) + ,getAllTxns,hasEmptyTxn + ) + where + +import Lib (toDate,getIntervalFactors) +import Util (mulBR, mulBInt) +import Types +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Aeson hiding (json) +import Text.Regex.Base +import Text.Regex.PCRE +import Data.Fixed +import Data.List +import qualified Data.DList as DL +import Data.Maybe +import GHC.Generics +import qualified Data.Set as Set +import qualified Data.Vector as V +import qualified Data.Text as T +import qualified Data.Map as M + +import Control.Applicative (liftA2) +import Control.Lens hiding (element,Empty) +import Control.Lens.TH + +import Debug.Trace +debug = flip trace + + +aggByTxnComment :: [Txn] -> M.Map TxnComment [Txn] -> M.Map TxnComment Balance +aggByTxnComment [] m = M.map sumTxn m +aggByTxnComment (txn:txns) m + | M.member c m = aggByTxnComment txns (M.adjust ([txn] ++) c m) + | otherwise = aggByTxnComment txns (M.insert c [txn] m) + where + c = normalized $ getTxnComment txn + normalized (FundWith bn _) = FundWith bn 0 + normalized (PurchaseAsset n _) = PurchaseAsset n 0 + normalized (TxnComments txns) = TxnComments [ normalized x | x <- txns ] + normalized cmt = cmt + +scaleTxn :: Rate -> Txn -> Txn +scaleTxn r (BondTxn d b i p r0 c di dioi f t) = BondTxn d (mulBR b r) (mulBR i r) (mulBR p r) r0 (mulBR c r) (mulBR di r) (mulBR dioi r) f t +scaleTxn r (AccTxn d b a t) = AccTxn d (mulBR b r) (mulBR a r) t +scaleTxn r (ExpTxn d b a b0 t) = ExpTxn d (mulBR b r) (mulBR a r) (mulBR b0 r) t +scaleTxn r (SupportTxn d b b0 i p c t) = SupportTxn d (flip mulBR r <$> b) (mulBR b0 r) (mulBR i r) (mulBR p r) (mulBR c r) t +scaleTxn r (IrsTxn d b a i0 i1 b0 t) = IrsTxn d (mulBR b r) (mulBR a r) i0 i1 (mulBR b0 r) t +scaleTxn r (EntryTxn d b a t) = EntryTxn d (mulBR b r) (mulBR a r) t + +scaleByFactor :: Rate -> [Txn] -> [Txn] +scaleByFactor r [] = [] +scaleByFactor r txns = map (scaleTxn r) txns + +sumTxn :: [Txn] -> Balance +sumTxn txns = sum $ getTxnAmt <$> txns + +getTxnComment :: Txn -> TxnComment +getTxnComment (BondTxn _ _ _ _ _ _ _ _ _ t) = t +getTxnComment (AccTxn _ _ _ t ) = t +getTxnComment (ExpTxn _ _ _ _ t ) = t +getTxnComment (SupportTxn _ _ _ _ _ _ t ) = t +getTxnComment (IrsTxn _ _ _ _ _ _ t ) = t +getTxnComment (EntryTxn _ _ _ t ) = t +getTxnComment (TrgTxn _ _ t) = t + +getTxnBalance :: Txn -> Balance +getTxnBalance (BondTxn _ t _ _ _ _ _ _ _ _) = t +getTxnBalance (AccTxn _ t _ _ ) = t +getTxnBalance (ExpTxn _ t _ _ _ ) = t +getTxnBalance (SupportTxn _ _ t _ _ _ _ ) = t -- drawed balance +getTxnBalance (EntryTxn _ t _ _) = t + +-- | SupportTxn Date (Maybe Balance) Balance DueInt DuePremium Cash TxnComment + +getTxnBegBalance :: Txn -> Balance +getTxnBegBalance (BondTxn _ t _ p _ _ _ _ _ _) = t + p +getTxnBegBalance (AccTxn _ b a _ ) = b - a +getTxnBegBalance (SupportTxn _ _ a b _ _ _) = b + a +getTxnBegBalance (EntryTxn _ a b _) = a + b + +getTxnPrincipal :: Txn -> Balance +getTxnPrincipal (BondTxn _ _ _ t _ _ _ _ _ _) = t + +getTxnAmt :: Txn -> Balance +getTxnAmt (BondTxn _ _ _ _ _ t _ _ _ _) = t +getTxnAmt (AccTxn _ _ t _ ) = t +getTxnAmt (ExpTxn _ _ t _ _ ) = t +getTxnAmt (SupportTxn _ _ _ _ _ t _) = t +getTxnAmt (IrsTxn _ _ t _ _ _ _ ) = t +getTxnAmt (EntryTxn _ _ t _) = t +getTxnAmt TrgTxn {} = 0.0 + +getTxnAsOf :: [Txn] -> Date -> Maybe Txn +getTxnAsOf txns d = find (\x -> getDate x <= d) $ reverse txns + +emptyTxn :: Txn -> Date -> Txn +emptyTxn BondTxn {} d = BondTxn d 0 0 0 0 0 0 0 Nothing Empty +emptyTxn AccTxn {} d = AccTxn d 0 0 Empty +emptyTxn ExpTxn {} d = ExpTxn d 0 0 0 Empty +emptyTxn SupportTxn {} d = SupportTxn d Nothing 0 0 0 0 Empty +emptyTxn IrsTxn {} d = IrsTxn d 0 0 0 0 0 Empty +emptyTxn EntryTxn {} d = EntryTxn d 0 0 Empty +emptyTxn TrgTxn {} d = TrgTxn d False Empty + +isEmptyTxn :: Txn -> Bool +isEmptyTxn (BondTxn _ 0 0 0 _ 0 0 0 _ Empty) = True +isEmptyTxn (AccTxn _ 0 0 Empty) = True +isEmptyTxn (ExpTxn _ 0 0 0 Empty) = True +isEmptyTxn (SupportTxn _ Nothing 0 0 0 0 Empty) = True +isEmptyTxn (IrsTxn _ 0 0 0 0 0 Empty) = True +isEmptyTxn (EntryTxn _ 0 0 Empty) = True +isEmptyTxn _ = False + +viewBalanceAsOf :: Date -> [Txn] -> Balance +viewBalanceAsOf d [] = 0.0 +viewBalanceAsOf d txns + | d < begDate = getTxnBegBalance fstTxn -- `debug` (" get first txn") + | d > endDate = getTxnBalance lstTxn -- `debug` (" get last txn") + | otherwise = getTxnBalance $ fromJust $ getTxnAsOf txns d -- `debug` ("Found txn>>>>>"++show d++show (getTxnAsOf txns d)) + where + fstTxn = head txns + lstTxn = last txns + begDate = getDate fstTxn + endDate = getDate lstTxn + +weightAvgBalanceByDates :: [Date] -> [Txn] -> [Balance] +weightAvgBalanceByDates ds txns + = (\(_sd,_ed) -> weightAvgBalance _sd _ed txns) <$> intervals -- `debug` ("interval"++ show intervals++ show txns) + where + intervals = zip (init ds) (tail ds) + +-- ^ Txn must be full transactions +weightAvgBalance :: Date -> Date -> [Txn] -> Balance -- txn has to be between sd & ed +weightAvgBalance sd ed txns + = sum $ zipWith mulBR bals dsFactor -- `debug` ("WavgBalace "++show bals++show dsFactor) + where + _txns = sliceBy IE sd ed txns + bals = map getTxnBegBalance _txns ++ [getTxnBalance (last _txns)] + ds = [sd] ++ map getDate _txns ++ [ed] + dsFactor = getIntervalFactors ds -- `debug` ("DS>>>"++show ds) + +weightAvgBalance' :: Date -> Date -> [Txn] -> Balance +weightAvgBalance' sd ed [] = 0.0 +weightAvgBalance' sd ed (_txn:_txns) + = let + -- txns = sliceBy EE sd ed txns + txns = reverse $ foldl consolTxn [_txn] _txns + viewDs = sort $ [sd,ed] ++ (getDate <$> (sliceBy EE sd ed txns)) + balances = flip viewBalanceAsOf txns <$> viewDs -- `debug` ("get bal snapshot"++ show viewDs++ ">>>"++show txns) + factors = getIntervalFactors viewDs + in + sum $ zipWith mulBR balances factors --`debug` ("In weight avg bal: Factors"++show factors++"Balances"++show balances ++ "interval "++ show (sd,ed)) + +data Statement = Statement (DL.DList Txn) + deriving (Show, Generic, Eq, Ord, Read) + +appendStmt :: Txn -> Maybe Statement -> Maybe Statement +appendStmt txn (Just stmt@(Statement txns)) = Just $ Statement (DL.snoc txns txn) +appendStmt txn Nothing = Just $ Statement $ DL.singleton txn + + + + +statementTxns :: Lens' Statement (DL.DList Txn) +statementTxns = lens getter setter + where + getter (Statement txns) = txns + setter (Statement _) txns = Statement txns + + +consolTxn :: [Txn] -> Txn -> [Txn] +consolTxn [] txn = [txn] +consolTxn (txn:txns) txn0 + | getDate txn == getDate txn0 = combineTxn txn txn0:txns + | otherwise = txn0:txn:txns + +getTxns :: Maybe Statement -> DL.DList Txn +getTxns Nothing = DL.empty +getTxns (Just (Statement txn)) = txn + +combineTxn :: Txn -> Txn -> Txn +combineTxn (BondTxn d1 b1 i1 p1 r1 c1 f1 g1 h1 m1) (BondTxn d2 b2 i2 p2 r2 c2 f2 g2 h2 m2) + = let + rateToSet (FundWith _ _) _ = r2 + rateToSet _ (FundWith _ _) = r1 + rateToSet _ _ = r2 + in + BondTxn d1 b2 (i1 + i2) (p1 + p2) (rateToSet m1 m2) (c1+c2) f2 g2 h2 (TxnComments [m1,m2]) +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 -- 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 +getFlow comment = + case comment of + PayInt _ -> Outflow + PayYield _ -> Outflow + PayPrin _ -> Outflow + PayGroupPrin _ -> Outflow + PayGroupInt _ -> Outflow + PayPrinResidual _ -> Outflow + PayFee _ -> Outflow + SeqPayFee _ -> Outflow + PayFeeYield _ -> Outflow + LiquidationRepay _ -> Outflow + SwapOutSettle _ -> Outflow + PurchaseAsset _ _-> Outflow + Transfer _ _ -> Interflow + TransferBy {} -> Interflow + FundWith _ _ -> Inflow + PoolInflow _ _ -> Inflow + LiquidationProceeds _ -> Inflow + LiquidationSupport _ -> Inflow + BankInt -> Inflow + SwapInSettle _ -> Inflow + IssuanceProceeds _ -> Inflow + LiquidationDraw -> Noneflow + LiquidationSupportInt _ _ -> Noneflow + WriteOff _ _ -> Noneflow + SupportDraw -> Noneflow + Empty -> Noneflow + Tag _ -> Noneflow + UsingDS _ -> Noneflow + SwapAccrue -> Noneflow + TxnDirection _ -> Noneflow + BookLedgerBy _ _ -> Noneflow + TxnComments cmts -> --TODO the direction of combine txns + let + directionList = getFlow <$> cmts + in + if Outflow `elem` directionList then + Outflow + else if any (Inflow ==) directionList then + Inflow + else + Noneflow + _ -> error ("Missing in GetFlow >> "++ show comment) + +-- ^ filter transaction by apply a filter function on txn comment +filterTxn :: (TxnComment -> Bool) -> [Txn] -> [Txn] +filterTxn f = filter (f . getTxnComment) + +instance Ord Txn where + compare :: Txn -> Txn -> Ordering + compare (BondTxn d1 _ _ _ _ _ _ _ _ _) (BondTxn d2 _ _ _ _ _ _ _ _ _) = compare d1 d2 + compare (AccTxn d1 _ _ _ ) (AccTxn d2 _ _ _ ) = compare d1 d2 + +instance TimeSeries Txn where + getDate (BondTxn t _ _ _ _ _ _ _ _ _ ) = t + getDate (AccTxn t _ _ _ ) = t + getDate (ExpTxn t _ _ _ _ ) = t + getDate (SupportTxn t _ _ _ _ _ _) = t + getDate (IrsTxn t _ _ _ _ _ _) = t + getDate (EntryTxn t _ _ _) = t + +class QueryByComment a where + + queryStmt :: a -> TxnComment -> [Txn] + + queryStmtAsOf :: a -> Date -> TxnComment -> [Txn] + queryStmtAsOf a d tc = [ txn | txn <- queryStmt a tc, getDate txn <= d] + + queryTxnAmt :: a -> TxnComment -> Balance + queryTxnAmt a tc = sum $ map getTxnAmt $ queryStmt a tc + + queryTxnAmtAsOf :: a -> Date -> TxnComment -> Balance + queryTxnAmtAsOf a d tc = sum $ getTxnAmt <$> queryStmtAsOf a d tc + + +class HasStmt a where + getAllTxns :: a -> [Txn] + hasEmptyTxn :: a -> Bool + +$(deriveJSON defaultOptions ''Statement) diff --git a/src/Triggers.hs b/src/Triggers.hs new file mode 100644 --- /dev/null +++ b/src/Triggers.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module Triggers( + Trigger(..),TriggerEffect(..),TriggerName,trgStatusLens +) + where + +import qualified Data.Text as T +import qualified Stmt as S +import qualified Liability as L +import Text.Read (readMaybe) +import Lib +import Types +import Accounts (ReserveAmount) +import Waterfall (Action,CollectionRule) +import Data.Aeson ( defaultOptions ) +import Language.Haskell.TH +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Fixed +import Data.Maybe +import Data.Map +import GHC.Generics +import Control.Lens +-- import qualified Liability as L + +type TriggerName = String + + +data TriggerEffect = DealStatusTo DealStatus -- ^ change deal status + | DoAccrueFee FeeNames -- ^ accure fee + | AddTrigger Trigger -- ^ add a new trigger + | ChangeReserveBalance String ReserveAmount -- ^ update reserve target balance + | CloseDeal (Int, DatePattern) (Int, DatePattern) + (PricingMethod, AccountName, Maybe DealStats) + (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 + deriving (Show, Eq, Generic,Ord) + +data Trigger = Trigger { + trgCondition :: Pre -- ^ condition to trigger + ,trgEffects :: TriggerEffect -- ^ what happen if it was triggered + ,trgStatus :: Bool -- ^ if it is triggered or not + ,trgCurable :: Bool -- ^ if it is curable trigger + ,trgStmt :: Maybe S.Statement -- ^ Transaction stmt + } deriving (Show, Eq, Generic,Ord) + +makeLensesFor [("trgStatus","trgStatusLens") + ,("trgEffects","trgEffectsLens") + ,("trgCondition","trgConditionLens") + ,("trgCurable","trgCurableLens")] ''Trigger + +$(concat <$> traverse (deriveJSON defaultOptions) [''TriggerEffect, ''Trigger]) diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,1214 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} + + +module Types + (DayCount(..),DateType(..) + ,DatePattern(..) + ,BondName,BondNames,FeeName,FeeNames,AccName,AccNames,AccountName + ,Ts(..),TsPoint(..),PoolSource(..) + ,PerPoint(..),PerCurve(..),getValFromPerCurve + ,Period(..), Threshold(..) + ,RangeType(..),CutoffType(..),DealStatus(..) + ,Balance,Index(..) + ,Cmp(..),TimeHorizion(..) + ,Date,Dates,TimeSeries(..),IRate,Amount,Rate,StartDate,EndDate,Lag + ,Spread,Floor,Cap,Interest,Principal,Cash,Default,Loss,Rental,PrepaymentPenalty + ,SplitType(..),BookItem(..),BookItems,BalanceSheetReport(..),CashflowReport(..) + ,Floater,CeName,RateAssumption(..) + ,PrepaymentRate,DefaultRate,RecoveryRate,RemainTerms,Recovery,Prepayment + ,Table(..),lookupTable,Direction(..),epocDate,BorrowerNum + ,Txn(..),TxnComment(..) + ,RoundingBy(..),DateDirection(..) + ,BookDirection(..),IRR(..),DealCycle(..),Limit(..),Pre(..) + ,Liable(..),CumPrepay,CumDefault,CumDelinq,CumPrincipal,CumLoss,CumRecovery,PoolId(..) + ,DealName,lookupIntervalTable,CutoffFields(..),PriceResult(..) + ,DueInt,DuePremium, DueIoI,DateVector,DealStats(..) + ,PricingMethod(..),CustomDataType(..),ResultComponent(..),DealStatType(..) + ,ActionWhen(..),DealStatFields(..) + ,getDealStatType,getPriceValue,preHasTrigger + ,MyRatio,HowToPay(..),BondPricingMethod(..),InvestorAction(..) + ,_BondTxn ,_InspectBal, _IrrResult + ) + where + +import qualified Data.Text as Text +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Time as Time +import qualified Data.Time.Format as TF +import qualified Data.Map as Map +import qualified Data.List.Split +import Text.Regex.Base +import Text.Regex.PCRE +import GHC.Generics +import Language.Haskell.TH + +import Control.Lens hiding (element,Index,Empty) +import Control.Lens.TH + +import Text.Read (readMaybe, get) +import Data.Aeson (ToJSON, toJSON, Value(String)) +import Data.Ratio (Ratio, numerator, denominator) +import Data.Text (pack) +import Control.DeepSeq (NFData,rnf) + +import Data.Scientific (fromRationalRepetend,formatScientific, Scientific,FPFormat(Fixed)) + +import Data.Aeson hiding (json) +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Fixed hiding (Ratio) +import Data.Decimal +import Data.Ix + + +import Data.List (intercalate, findIndex, find) +-- import Cashflow (CashFlowFrame) + +-- import Web.Hyperbole hiding (All,Fixed) + +import Debug.Trace +-- import qualified Cashflow as CF +debug = flip trace + + + +type BondName = String +type BondNames = [String] +type FeeName = String +type FeeNames = [String] +type AccName = String +type AccountName = String +type AccNames = [String] +type CeName = String +type Comment = String + +type Date = Time.Day +type Dates = [Time.Day] +type StartDate = Date +type EndDate = Date +type LastIntPayDate = Date + +type Balance = Centi +-- type Balance = Decimal +type Amount = Balance +type Principal = Balance +type Valuation = Balance + +type Interest = Balance +type Default = Balance +type Loss = Balance +type Cash = Balance +type Recovery = Balance +type Prepayment = Balance +type Rental = Balance +type PrepaymentPenalty = Balance +type CumPrepay = Balance +type CumPrincipal = Balance +type CumDefault = Balance +type CumDelinq = Balance +type CumLoss = Balance +type CumRecovery = Balance +type AccruedInterest = Balance + +type PerFace = Micro +type WAL = Balance +type Duration = Micro +type Convexity = Micro +type Yield = Micro +type IRR = Micro + +type Rate = Rational -- general Rate like pool factor +type PrepaymentRate = Rate +type DefaultRate = Rate +type RecoveryRate = Rate + +type IRate = Micro -- Interest Rate Type +type Spread = Micro +type Floor = Micro +type Cap = Micro + +type RemainTerms = Int +type BorrowerNum = Int +type Lag = Int + + +data Index = LPR5Y + | LPR1Y + | LIBOR1M + | LIBOR3M + | LIBOR6M + | LIBOR1Y + | USTSY1Y + | USTSY2Y + | USTSY3Y + | USTSY5Y + | USTSY7Y + | USTSY10Y + | USTSY20Y + | USTSY30Y + | USCMT1Y + | PRIME + | COFI + | SOFR1M + | SOFR3M + | SOFR6M + | SOFR1Y + | EURIBOR1M + | EURIBOR3M + | EURIBOR6M + | EURIBOR12M + | BBSW + | IRPH -- The IRPH (Índice de Referencia de Préstamos Hipotecarios) is a reference index used in Spain to fix the interest rate of mortgage loans + | SONIA + -- deriving (Show,Eq,Generic,Ord,Read, Bounded, Enum, Finite, Named, ProtoEnum) + deriving (Show,Eq,Generic,Ord,Read) + +type Floater = (Index,Spread) + +epocDate = Time.fromGregorian 1970 1 1 +-- http://www.deltaquants.com/day-count-conventions +data DayCount = DC_30E_360 -- ^ ISMA European 30S/360 Special German Eurobond Basis + | DC_30Ep_360 -- ^ 30E+/360 + | DC_ACT_360 -- ^ Actual/360 , French + | DC_ACT_365 + | DC_ACT_365A -- ^ Actual/365 Actual + | DC_ACT_365L -- ^ Actual/365 Leap Year + | DC_NL_365 -- ^ Actual/365 No leap year + | DC_ACT_365F -- ^ Actual /365 Fixed, English + | DC_ACT_ACT -- ^ Actual/Actual ISDA + | DC_30_360_ISDA -- ^ IDSA + | DC_30_360_German -- ^ Gernman + | DC_30_360_US -- ^ 30/360 US Municipal , Bond basis + deriving (Show,Eq,Generic,Ord,Read) + + +data DateType = ClosingDate -- ^ deal closing day + | CutoffDate -- ^ after which, the pool cashflow was aggregated to SPV + | FirstPayDate -- ^ first payment day for bond/waterfall to run with + | NextPayDate + | NextCollectDate + | FirstCollectDate -- ^ first collection day for pool + | LastCollectDate -- ^ last collection day for pool + | LastPayDate -- ^ last payment day for bond/waterfall + | StatedMaturityDate -- ^ sated maturity date, all cashflow projection/deal action stops by + | DistributionDates -- ^ distribution date for waterfall + | CollectionDates -- ^ collection date for pool + | CustomExeDates String -- ^ custom execution date + deriving (Show,Ord,Eq,Generic,Read) + + +data DatePattern = MonthEnd + | QuarterEnd + | YearEnd + | MonthFirst + | QuarterFirst + | MidYear + | YearFirst + | MonthDayOfYear Int Int -- T.MonthOfYear T.DayOfMonth + | DayOfMonth Int -- T.DayOfMonth + | SemiAnnual (Int, Int) (Int, Int) + | CustomDate [Date] + | SingletonDate Date + | DaysInYear [(Int, Int)] -- MM/DD + | EveryNMonth Date Int + | Weekday Int + | AllDatePattern [DatePattern] + | StartsExclusive Date DatePattern -- TODO depricated + | StartsAt CutoffType Date DatePattern + | EndsAt CutoffType Date DatePattern + | Exclude DatePattern [DatePattern] + | OffsetBy DatePattern Int + -- | DayOfWeek Int -- T.DayOfWeek + deriving (Show, Eq, Generic, Ord, Read) + + +data Period = Daily + | Weekly + | BiWeekly + | Monthly + | Quarterly + | SemiAnnually + | Annually + deriving (Show,Eq,Generic,Ord) + +type DateVector = (Date, DatePattern) + +data RoundingBy a = RoundCeil a + | RoundFloor a + deriving (Show, Generic, Eq, Ord, Read) + +type DealName = String + +data PoolId = PoolName String -- ^ pool name + | PoolConsol -- ^ consolidate pool ( the only pool ) + | 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 + | L -- ^ Less than + | LE -- ^ Less Equal than + | E -- ^ Equals to + deriving (Generic,Eq,Ord,Read) + +instance Show Cmp where + show :: Cmp -> String + show G = ">" + show GE = ">=" + show L = "<" + show LE = "<=" + show E = "==" + + +data PoolSource = CollectedInterest -- ^ interest + | CollectedPrincipal -- ^ schdule principal + | CollectedRecoveries -- ^ recoveries + | CollectedPrepayment -- ^ prepayment + | CollectedPrepaymentPenalty -- ^ prepayment pentalty + | CollectedRental -- ^ rental from pool + | CollectedFeePaid -- ^ fee from pool + | CollectedCash -- ^ cash from pool + | NewDefaults -- ^ new defaults in balance + | NewLosses -- ^ new losses in balance + | NewDelinquencies -- ^ new delinquencies in balance + | CurBalance -- ^ performing balance + | CurBegBalance -- ^ performing balance at the beginning of the period + deriving (Show,Ord,Read,Eq, Generic) + + +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) + +data PerCurve a = CurrentVal [PerPoint a] + | WithTrailVal [PerPoint a] + deriving (Show,Eq,Read,Generic,Ord) + +getValFromPerCurve :: PerCurve a -> DateDirection -> CutoffType -> Int -> Maybe a +getValFromPerCurve (WithTrailVal []) _ _ _ = Nothing +getValFromPerCurve (CurrentVal []) _ _ _ = Nothing +getValFromPerCurve (CurrentVal (v:vs)) Future p i + = let + cmp = case p of + Inc -> (>=) + Exc -> (>) + in + if cmp (getIdxFromPerPoint v) i then + Just $ getValFromPerPoint v + else + getValFromPerCurve (CurrentVal vs) Future p i + +getValFromPerCurve (CurrentVal vs) Past p i + = let + cmp = case p of + Inc -> (<=) + Exc -> (<) + ps = reverse vs + in + case find (\x -> cmp (getIdxFromPerPoint x) i) ps of + Just rs -> Just $ getValFromPerPoint rs + Nothing -> Nothing + + +getValFromPerCurve (WithTrailVal _ps) dr p i + = let + ps = case dr of + Future -> _ps + Past -> reverse _ps + cmp = case p of + Inc -> (>=) + Exc -> (>) + in + case find (\x -> cmp (getIdxFromPerPoint x) i) ps of + Nothing -> Just $ getValFromPerPoint (last ps) + Just rs -> Just $ getValFromPerPoint rs + +getIdxFromPerPoint :: PerPoint a -> Int +getIdxFromPerPoint (PerPoint i _) = i + +getValFromPerPoint :: PerPoint a -> a +getValFromPerPoint (PerPoint _ v) = v + + +instance Ord a => Ord (PerPoint a) where + compare (PerPoint i _) (PerPoint j _) = compare i j + +data RangeType = II -- ^ include both start and end date + | IE -- ^ include start date ,but not end date + | EI -- ^ exclude start date but include end date + | EE -- ^ exclude either start date and end date + | NO_IE -- ^ no handling on start date and end date + deriving (Show,Eq,Read,Generic,Ord) + +data CutoffType = Inc + | Exc + deriving (Show,Ord,Read,Generic,Eq) + +data DateDirection = Future + | Past + deriving (Show,Read,Generic) + +data InvestorAction = Buy + | Sell + deriving (Show,Ord,Read,Generic,Eq) + + +class TimeSeries ts where + cmp :: ts -> ts -> Ordering + cmp t1 t2 = compare (getDate t1) (getDate t2) + sameDate :: ts -> ts -> Bool + sameDate t1 t2 = getDate t1 == getDate t2 + getDate :: ts -> Date + getDates :: [ts] -> [Date] + getDates ts = [ getDate t | t <- ts ] + filterByDate :: [ts] -> Date -> [ts] + filterByDate ts d = filter (\x -> getDate x == d ) ts + sliceBy :: RangeType -> StartDate -> EndDate -> [ts] -> [ts] + sliceBy rt sd ed ts + = case rt of + II -> filter (\x -> getDate x >= sd && getDate x <= ed ) ts + IE -> filter (\x -> getDate x >= sd && getDate x < ed ) ts + EI -> filter (\x -> getDate x > sd && getDate x <= ed) ts + EE -> filter (\x -> getDate x > sd && getDate x < ed ) ts + _ -> error "Not support NO_IE for sliceBy in TimeSeries" + cutBy :: CutoffType -> DateDirection -> Date -> [ts] -> [ts] + cutBy ct dd d ts + = case (ct,dd) of + (Inc, Future) -> filter (\x -> getDate x >= d) ts + (Inc, Past) -> filter (\x -> getDate x <= d) ts + (Exc, Future) -> filter (\x -> getDate x > d) ts + (Exc, Past) -> filter (\x -> getDate x < d) ts + + cmpWith :: ts -> Date -> Ordering + cmpWith t d = compare (getDate t) d + + isAfter :: ts -> Date -> Bool + isAfter t d = getDate t > d + isOnAfter :: ts -> Date -> Bool + isOnAfter t d = getDate t >= d + isBefore :: ts -> Date -> Bool + isBefore t d = getDate t < d + isOnBefore :: ts -> Date -> Bool + isOnBefore t d = getDate t <= d + + splitBy :: Date -> CutoffType -> [ts] -> ([ts],[ts]) + splitBy d ct tss = + let + ffunR x = case ct of + Inc -> getDate x > d -- include ts in the Left + Exc -> getDate x >= d -- + ffunL x = case ct of + Inc -> getDate x <= d -- include ts in the Left + Exc-> getDate x < d -- + in + (filter ffunL tss, filter ffunR tss) + + getByDate :: Date -> [ts] -> Maybe ts + getByDate d ts = case filterByDate ts d of + [] -> Nothing + (x:_) -> Just x + +-- ^ different types of curves, which determine how to interpolate between two points +data Ts = FloatCurve [TsPoint Rational] + | BoolCurve [TsPoint Bool] + | BalanceCurve [TsPoint Balance] + | LeftBalanceCurve [TsPoint Balance] + | RatioCurve [TsPoint Rational] + | ThresholdCurve [TsPoint Rational] + | IRateCurve [TsPoint IRate] + | FactorCurveClosed [TsPoint Rational] Date + | PricingCurve [TsPoint Rational] + | PeriodCurve [TsPoint Int] + | IntCurve [TsPoint Int] + deriving (Show,Eq,Ord,Read,Generic) + + +data Direction = Up + | Down + deriving (Show,Read,Generic,Eq,Ord) + +-- ^ direction of the transaction, in terms of the book keeping +data BookDirection = Credit + | Debit + deriving (Show,Ord, Eq,Read, Generic) + + +type DueInt = Balance +type DuePremium = Balance +type DueIoI = Balance + +data DealCycle = EndCollection -- ^ | collection period collection action , waterfall action + | EndCollectionWF -- ^ | collection period collection action , waterfall action + | BeginDistributionWF -- ^ | collection period collection action , waterfall action + | EndDistributionWF -- ^ | collection period collection action , waterfall action + | InWF -- ^ | collection period collection action , waterfall action + deriving (Show, Ord, Eq, Read, Generic) + +-- ^ different status of the deal +data DealStatus = DealAccelerated (Maybe Date) -- ^ Deal is accelerated status with optinal accerlerated date + | DealDefaulted (Maybe Date) -- ^ Deal is defaulted status with optinal default date + | Amortizing -- ^ Deal is amortizing + | Revolving -- ^ Deal is revolving + | 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 Date -- ^ Deal is marked as closed + deriving (Show,Ord,Eq,Read, Generic) + +-- ^ pricing methods for assets +data PricingMethod = BalanceFactor Rate Rate -- ^ [balance] to be multiply with rate1 and rate2 if status of asset is "performing" or "defaulted" + | BalanceFactor2 Rate Rate Rate -- ^ [balance] by performing/delinq/default factor + | DefaultedBalance Rate -- ^ [balance] only liquidate defaulted balance + | PV IRate Rate -- ^ discount factor, recovery pct on default + | PVCurve Ts -- ^ [CF] Pricing cashflow with a Curve + | PvRate IRate -- ^ [CF] Pricing cashflow with a constant rate + | PvWal Ts + | PvByRef DealStats -- ^ [CF] Pricing cashflow with a ref rate + | Custom Rate -- ^ custom amount + deriving (Show, Eq ,Generic, Read, Ord) + +-- ^ pricing methods for bonds +data BondPricingMethod = BondBalanceFactor Rate + | PvBondByRate Rate + | PvBondByCurve Ts + deriving (Show, Eq ,Generic, Read, Ord) + + +-- ^ condition which can be evaluated to a boolean value +data Pre = IfZero DealStats + | If Cmp DealStats Balance + | IfRate Cmp DealStats Micro + | IfCurve Cmp DealStats Ts + | IfByPeriodCurve Cmp DealStats DealStats (PerCurve Balance) + | IfRateCurve Cmp DealStats Ts + | IfRateByPeriodCurve Cmp DealStats DealStats (PerCurve Rate) + | IfIntCurve Cmp DealStats Ts + -- Integer + | IfInt Cmp DealStats Int + | IfIntBetween DealStats RangeType Int Int + | IfIntIn DealStats [Int] + -- Dates + | IfDate Cmp Date + | IfDateBetween RangeType Date Date + | IfDateIn Dates + -- Bool + | IfBool DealStats Bool + -- compare deal status + | If2 Cmp DealStats DealStats + | IfRate2 Cmp DealStats DealStats + | IfInt2 Cmp DealStats DealStats + -- | IfRateCurve DealStats Cmp Ts + | IfDealStatus DealStatus + | Always Bool + | IfNot Pre + | Any [Pre] + | All [Pre] -- ^ + deriving (Show,Generic,Eq,Ord,Read) + + +data Table a b = ThresholdTable [(a,b)] + deriving (Show,Eq,Ord,Read,Generic) + + +data ActionType = ActionResetRate -- ^ reset interest rate from curve + | ActionAccrue -- ^ accrue liablity + deriving (Show,Eq,Ord,Read,Generic) + +-- ^ comment of the transaction in the accounts +data TxnComment = PayInt [BondName] + | PayYield BondName + | PayPrin [BondName] + | PayGroupPrin [BondName] + | PayGroupInt [BondName] + | WriteOff BondName Balance + | FundWith BondName Balance + | PayPrinResidual [BondName] + | PayFee FeeName + | SeqPayFee [FeeName] + | PayFeeYield FeeName + | Transfer AccName AccName + | TransferBy AccName AccName Limit + | BookLedgerBy BookDirection String + | PoolInflow (Maybe [PoolId]) PoolSource + | LiquidationProceeds [PoolId] + | LiquidationSupport String + | LiquidationDraw + | LiquidationRepay String + | LiquidationSupportInt Balance Balance + | BankInt + | SupportDraw + | Empty + | Tag String + | UsingDS DealStats + | SwapAccrue + | SwapInSettle String + | SwapOutSettle String + | PurchaseAsset String Balance + | IssuanceProceeds String + | TxnDirection BookDirection + | TxnComments [TxnComment] + deriving (Eq, Show, Ord ,Read, Generic) + +-- ^ transaction record in each entity +data Txn = BondTxn Date Balance Interest Principal IRate Cash DueInt DueIoI (Maybe Float) TxnComment -- ^ bond transaction record for interest and principal + | AccTxn Date Balance Amount TxnComment -- ^ account transaction record + | ExpTxn Date Balance Amount Balance TxnComment -- ^ expense transaction record + | SupportTxn Date (Maybe Balance) Balance DueInt DuePremium Cash TxnComment -- ^ liquidity provider transaction record + | IrsTxn Date Balance Amount IRate IRate Balance TxnComment -- ^ interest swap transaction record + | EntryTxn Date Balance Amount TxnComment -- ^ ledger book entry + | TrgTxn Date Bool TxnComment + deriving (Show, Generic, Eq, Read) + + +data DealStatFields = PoolCollectedPeriod + | BondPaidPeriod + deriving (Generic, Eq, Ord, Show, Read) + +-- ^ different types of deal stats +data DealStats = CurrentBondBalance + | CurrentPoolBalance (Maybe [PoolId]) + | CurrentPoolBegBalance (Maybe [PoolId]) + | CurrentPoolDefaultedBalance + | CumulativePoolDefaultedBalance (Maybe [PoolId]) -- ^ Depreciated, use PoolCumCollection + | CumulativePoolRecoveriesBalance (Maybe [PoolId]) -- ^ Depreciated, use PoolCumCollection + | CumulativeNetLoss (Maybe [PoolId]) + | OriginalBondBalance + | OriginalBondBalanceOf [BondName] + | BondTotalFunding [BondName] + | OriginalPoolBalance (Maybe [PoolId]) + | DealIssuanceBalance (Maybe [PoolId]) + | UseCustomData String + | PoolCumCollection [PoolSource] (Maybe [PoolId]) + | PoolCumCollectionTill Int [PoolSource] (Maybe [PoolId]) + | PoolCurCollection [PoolSource] (Maybe [PoolId]) + | PoolCollectionStats Int [PoolSource] (Maybe [PoolId]) + | PoolWaSpread (Maybe [PoolId]) + | AllAccBalance + | AccBalance [AccName] + | LedgerBalance [String] + | LedgerBalanceBy BookDirection [String] + | LedgerTxnAmt [String] (Maybe TxnComment) + | ReserveBalance [AccName] + | ReserveGap [AccName] + | ReserveExcess [AccName] + | ReserveGapAt Date [AccName] + | ReserveExcessAt Date [AccName] + | FutureCurrentPoolBalance (Maybe [PoolId]) + | FutureCurrentSchedulePoolBalance (Maybe [PoolId]) + | FutureCurrentSchedulePoolBegBalance (Maybe [PoolId]) + | PoolScheduleCfPv PricingMethod (Maybe [PoolId]) + | FuturePoolScheduleCfPv Date PricingMethod (Maybe [PoolId]) + | FutureWaCurrentPoolBalance Date Date (Maybe [PoolId]) + | FutureCurrentPoolBegBalance (Maybe [PoolId]) + | FutureCurrentBondBalance Date + | CurrentBondBalanceOf [BondName] + | BondIntPaidAt Date BondName + | BondsIntPaidAt Date [BondName] + | BondPrinPaidAt Date BondName + | BondsPrinPaidAt Date [BondName] + | BondBalanceTarget [BondName] + | BondBalanceGap BondName + | BondBalanceGapAt Date BondName + | BondDuePrin [BondName] + | BondReturn BondName Balance [TsPoint Amount] + | FeePaidAmt [FeeName] + | FeeTxnAmt [FeeName] (Maybe TxnComment) + | BondTxnAmt [BondName] (Maybe TxnComment) + | AccTxnAmt [AccName] (Maybe TxnComment) + | FeeTxnAmtBy Date [FeeName] (Maybe TxnComment) + | BondTxnAmtBy Date [BondName] (Maybe TxnComment) + | AccTxnAmtBy Date [AccName] (Maybe TxnComment) + | FeesPaidAt Date [FeeName] + | CurrentDueBondInt [BondName] + | CurrentDueBondIntAt Int [BondName] + | CurrentDueBondIntOverInt [BondName] + | CurrentDueBondIntOverIntAt Int [BondName] + | CurrentDueBondIntTotal [BondName] + | CurrentDueBondIntTotalAt Int [BondName] + | CurrentDueFee [FeeName] + | LastBondIntPaid [BondName] + | LastBondPrinPaid [BondName] + | LastFeePaid [FeeName] + | LiqCredit [String] + | LiqBalance [String] + | RateCapNet String + | RateSwapNet String + | BondBalanceHistory Date Date + | PoolCollectionHistory PoolSource Date Date (Maybe [PoolId]) + | UnderlyingBondBalance (Maybe [BondName]) + | WeightedAvgCurrentPoolBalance Date Date (Maybe [PoolId]) + | WeightedAvgCurrentBondBalance Date Date [BondName] + | WeightedAvgOriginalPoolBalance Date Date (Maybe [PoolId]) + | WeightedAvgOriginalBondBalance Date Date [BondName] + | CustomData String Date + | DealStatBalance DealStatFields + -- analytical query + | AmountRequiredForTargetIRR Double BondName + -- integer type + | CurrentPoolBorrowerNum (Maybe [PoolId]) + | FutureCurrentPoolBorrowerNum Date (Maybe [PoolId]) + | ProjCollectPeriodNum + | MonthsTillMaturity BondName + | DealStatInt DealStatFields + -- boolean type + | TestRate DealStats Cmp Micro + | TestAny Bool [DealStats] + | TestAll Bool [DealStats] + | TestNot DealStats + | IsDealStatus DealStatus + | IsMostSenior BondName [BondName] + | IsPaidOff [BondName] + | IsFeePaidOff [String] + | IsLiqSupportPaidOff [String] + | IsRateSwapPaidOff [String] + | IsOutstanding [BondName] + | HasPassedMaturity [BondName] + | TriggersStatus DealCycle String + | DealStatBool DealStatFields + -- rate type + | PoolWaRate (Maybe PoolId) + | BondRate BondName + | CumulativeNetLossRatio (Maybe [PoolId]) + | FutureCurrentBondFactor Date + | FutureCurrentPoolFactor Date (Maybe [PoolId]) + | BondFactor + | BondFactorOf BondName + | CumulativePoolDefaultedRate (Maybe [PoolId]) + | CumulativePoolDefaultedRateTill Int (Maybe [PoolId]) + | PoolFactor (Maybe [PoolId]) + | BondWaRate [BondName] + | DealStatRate DealStatFields + -- Compond type + | Factor DealStats Rational + | Multiply [DealStats] + | Max [DealStats] + | Min [DealStats] + | Sum [DealStats] + | Substract [DealStats] + | Subtract [DealStats] + | Excess [DealStats] + | Avg [DealStats] + | AvgRatio [DealStats] + | Divide DealStats DealStats + | DivideRatio DealStats DealStats + | Constant Rational + | FloorAndCap DealStats DealStats DealStats + | FloorWith DealStats DealStats + | FloorWithZero DealStats + | CapWith DealStats DealStats + | Abs DealStats + | Round DealStats (RoundingBy Rational) + deriving (Show,Eq,Ord,Read,Generic) + +preHasTrigger :: Pre -> [(DealCycle,String)] +preHasTrigger (IfBool (TriggersStatus dc tName) _) = [(dc,tName)] +preHasTrigger (Any ps) = concat $ preHasTrigger <$> ps +preHasTrigger (All ps) = concat $ preHasTrigger <$> ps +preHasTrigger _ = [] + + +data Limit = DuePct Rate -- ^ up to % of total amount due + | DueCapAmt Balance -- ^ up to $ amount + | KeepBalAmt DealStats -- ^ pay till a certain amount remains in an account + | DS DealStats -- ^ transfer with limit described by a `DealStats` + -- | ClearLedger BookDirection String -- ^ when transfer, clear the ledger by transfer amount + -- | ClearLedgerBySeq BookDirection [String] -- ^ clear a direction to a sequence of ledgers + -- | BookLedger String -- ^ when transfer, book the ledger by the transfer amount + | RemainBalPct Rate -- ^ pay till remain balance equals to a percentage of `stats` + | TillTarget -- ^ transfer amount which make target account up reach reserve balanace + | TillSource -- ^ transfer amount out till source account down back to reserve balance + | Multiple Limit Float -- ^ factor of a limit + deriving (Show,Ord,Eq,Read, Generic) + +data HowToPay = ByProRata + | BySequential + deriving (Show,Ord,Eq,Read, Generic) + +type BookItems = [BookItem] + +data BookItem = Item String Balance + | ParentItem String BookItems + deriving (Show,Read,Generic,Eq) + +data BalanceSheetReport = BalanceSheetReport { + asset :: BookItem + ,liability :: BookItem + ,equity :: BookItem + ,reportDate :: Date} -- ^ snapshot date of the balance sheet + deriving (Show,Read,Generic,Eq) + +data CashflowReport = CashflowReport { + inflow :: BookItem + ,outflow :: BookItem + ,net :: BookItem + ,startDate :: Date + ,endDate :: Date } + deriving (Show,Read,Generic,Eq) + + +data Threshold = Below + | EqBelow + | Above + | EqAbove + deriving (Show,Eq,Ord,Read,Generic) + +data SplitType = EqToLeft -- if equal, the element belongs to left + | EqToRight -- if equal, the element belongs to right + | EqToLeftKeepOne + | EqToLeftKeepOnes + deriving (Show, Eq, Generic) + +-- ^ 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 + | HistoryFeePaid + | 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) + +makePrisms ''PriceResult + +getPriceValue :: PriceResult -> Balance +getPriceValue (AssetPrice v _ _ _ _ ) = v +getPriceValue (PriceResult v _ _ _ _ _ _) = v +getPriceValue x = error $ "failed to match with type when geting price value" ++ show x + + +getValuation :: PriceResult -> PerFace +getValuation (PriceResult _ val _ _ _ _ _) = val +getValuation (OASResult pr _ _) = getValuation pr +getValuation pr = error $ "not support for pricing result"++ show pr + + +class Liable lb where + + -- must implement + isPaidOff :: lb -> Bool + getCurBalance :: lb -> Balance + getCurRate :: lb -> IRate + getOriginBalance :: lb -> Balance + getOriginDate :: lb -> Date + getAccrueBegDate :: lb -> Date + getDueInt :: lb -> Balance + getDueIntAt :: lb -> Int -> Balance + getDueIntOverInt :: lb -> Balance + getDueIntOverIntAt :: lb -> Int -> Balance + getTotalDueInt :: lb -> Balance + getTotalDueIntAt :: lb -> Int -> Balance + + getOutstandingAmount :: lb -> Balance + + -- optional implement + -- getTotalDue :: [lb] -> Balance + -- getTotalDue lbs = sum $ getDue <$> lbs + + +class Accruable ac where + accrue :: Date -> ac -> ac + calcAccrual :: Date -> ac -> Balance + + -- buildAccrualAction :: ac -> Date -> Date -> [ActionOnDate] + +-- class Resettable rs where +-- reset :: Date -> rs -> rs +-- buildResetAction :: rs -> Date -> Date -> [Txn] + +lookupTable :: Ord a => Table a b -> Direction -> (a -> Bool) -> Maybe b +lookupTable (ThresholdTable rows) direction lkUpFunc + = case findIndex lkUpFunc rs of + Nothing -> Nothing + Just i -> Just $ vs!!i + where + rs = case direction of + Up -> reverse $ map fst rows + Down -> map fst rows + vs = case direction of + Up -> reverse $ map snd rows + Down -> map snd rows + +lookupIntervalTable :: Ord a => Table a b -> Direction -> (a -> Bool) -> Maybe ((a,b),(a,b)) +lookupIntervalTable (ThresholdTable rows) direction lkUpFunc + = case findIndex lkUpFunc rs of + Nothing -> Nothing + Just i -> if succ i == length rows then + Nothing + else + Just $ (rows!!i, rows!!(i+1)) -- `debug` ("Find index"++ show i) + where + rs = case direction of + Up -> reverse $ map fst rows + Down -> map fst rows + + +data RateAssumption = RateCurve Index Ts -- ^ a rate curve ,which value of rates depends on time + | RateFlat Index IRate -- ^ a rate constant + deriving (Show, Generic) + +data TimeHorizion = ByMonth + | ByYear + | ByQuarter + +instance TimeSeries (TsPoint a) where + getDate (TsPoint d a) = d + + +$(deriveJSON defaultOptions ''DecimalRaw) +$(deriveJSON defaultOptions ''TsPoint) +$(deriveJSON defaultOptions ''PerPoint) +$(deriveJSON defaultOptions ''Ts) +$(deriveJSON defaultOptions ''Cmp) +$(deriveJSON defaultOptions ''PoolSource) +$(deriveJSON defaultOptions ''RoundingBy) +$(deriveJSON defaultOptions ''PoolId) + + + +instance ToJSONKey PoolId where + toJSONKey :: ToJSONKeyFunction PoolId + toJSONKey = toJSONKeyText (T.pack . show) + +instance FromJSONKey PoolId where + fromJSONKey = FromJSONKeyTextParser $ \t -> case readMaybe (T.unpack t) of + Just k -> pure k + Nothing -> fail ("Invalid key: " ++ show t++">>"++ show (T.unpack t)) + +-- ^ different types of waterfall execution +data ActionWhen = EndOfPoolCollection -- ^ waterfall executed at the end of pool collection + | DistributionDay DealStatus -- ^ waterfall executed depends on deal status + | CleanUp -- ^ waterfall exectued upon a clean up call + | OnClosingDay -- ^ waterfall executed on deal closing day + | DefaultDistribution -- ^ default waterfall executed + | RampUp -- ^ ramp up + | WithinTrigger String -- ^ waterfall executed within a trigger + | CustomWaterfall String -- ^ custom waterfall + deriving (Show,Ord,Eq,Generic,Read) + + +data ResultComponent = CallAt Date -- ^ the date when deal called + | DealStatusChangeTo Date DealStatus DealStatus String -- ^ record when & why status changed + | BondOutstanding String Balance Balance -- ^ when deal ends,calculate oustanding principal balance + | BondOutstandingInt String Balance Balance -- ^ when deal ends,calculate oustanding interest due + | InspectBal Date DealStats Balance -- ^ A bal value from inspection + | InspectInt Date DealStats Int -- ^ A int value from inspection + | InspectRate Date DealStats Micro -- ^ A rate value from inspection + | InspectBool Date DealStats Bool -- ^ A bool value from inspection + | RunningWaterfall Date ActionWhen -- ^ running waterfall at a date + | FinancialReport StartDate EndDate BalanceSheetReport CashflowReport + | InspectWaterfall Date (Maybe String) [DealStats] [String] + | ErrorMsg String + | WarningMsg String + | EndRun (Maybe Date) String -- ^ end of run with a message + -- | SnapshotCashflow Date String CashFlowFrame + deriving (Show, Generic,Eq) + +makePrisms ''ResultComponent + + +listToStrWithComma :: [String] -> String +listToStrWithComma = intercalate "," + +instance ToJSON TxnComment where + toJSON (PayInt bns ) = String $ T.pack $ "" + toJSON (PayYield bn ) = String $ T.pack $ "" + toJSON (PayPrin bns ) = String $ T.pack $ "" + toJSON (WriteOff bn amt ) = String $ T.pack $ "" + toJSON (FundWith b bal) = String $ T.pack $ "" + toJSON (PayPrinResidual bns ) = String $ T.pack $ "" + toJSON (PayFee fn ) = String $ T.pack $ "" + toJSON (SeqPayFee fns) = String $ T.pack $ "" + toJSON (PayFeeYield fn) = String $ T.pack $ "" + toJSON (Transfer an1 an2) = String $ T.pack $ "" + toJSON (TransferBy an1 an2 limit) = String $ T.pack $ "" + toJSON (PoolInflow mPids ps) = String $ T.pack $ ")) mPids ++":"++ show ps++">" + toJSON (LiquidationProceeds pids) = String $ T.pack $ " pids) ++">" + toJSON (UsingDS ds) = String $ T.pack $ "" + toJSON BankInt = String $ T.pack $ "" + toJSON Empty = String $ T.pack $ "" + toJSON (LiquidationSupport source) = String $ T.pack $ "" + toJSON (LiquidationSupportInt b1 b2) = String $ T.pack $ "" + toJSON LiquidationDraw = String $ T.pack $ "" + toJSON (LiquidationRepay s) = String $ T.pack $ "" + toJSON SwapAccrue = String $ T.pack $ "" + toJSON (SwapInSettle s)= String $ T.pack $ "" + toJSON (SwapOutSettle s) = String $ T.pack $ "" + toJSON (PurchaseAsset rPoolName bal) = String $ T.pack $ " rPoolName <>","++show bal++">" + toJSON (TxnDirection dr) = String $ T.pack $ "" + toJSON SupportDraw = String $ T.pack $ "" + toJSON (IssuanceProceeds nb) = String $ T.pack $ "" + toJSON (Tag cmt) = String $ T.pack $ "" + toJSON (TxnComments tcms) = Array $ V.fromList $ map toJSON tcms + toJSON (PayGroupInt bns) = String $ T.pack $ "" + toJSON (PayGroupPrin bns) = String $ T.pack $ "" + toJSON (BookLedgerBy dr lName) = String $ T.pack $ "" + toJSON x = error $ "Not support for toJSON for "++show x + +instance FromJSON TxnComment where + parseJSON = withText "Empty" parseTxn + +parseTxn :: T.Text -> Parser TxnComment +parseTxn "" = return Empty +parseTxn "" = return BankInt +parseTxn t = case tagName of + "Transfer" -> let + sv = T.splitOn (T.pack ",") $ T.pack contents + in + return $ Transfer (T.unpack (head sv)) (T.unpack (sv!!1)) + "Support" -> return $ LiquidationSupport contents + "PayInt" -> return $ PayInt [contents] + "PayYield" -> return $ PayYield contents + "PayPrin" -> return $ PayPrin [contents] + "WriteOff" -> let + sv = T.splitOn (T.pack ",") $ T.pack contents + in + return $ WriteOff (T.unpack (head sv)) (read (T.unpack (sv!!1))::Balance) + "PayPrinResidual" -> return $ PayPrinResidual [contents] + "PayFee" -> return $ PayFee contents + "SeqPayFee" -> return $ SeqPayFee [contents] + "PayFeeYield" -> return $ PayFeeYield contents + "TransferBy" -> let + sv = T.splitOn (T.pack ",") $ T.pack contents + in + return $ TransferBy (T.unpack (head sv)) (T.unpack (sv!!1)) (read (T.unpack (sv!!2))::Limit) + "Pool" -> let + sr = T.splitOn (T.pack ":") $ T.pack contents + mPids = if head sr == "Nothing" then + Nothing + else + Just (read <$> T.unpack <$> sr)::(Maybe [PoolId]) + in + return $ PoolInflow mPids (read (T.unpack (sr!!1))::PoolSource) + "Liquidation" -> let + sv = T.splitOn (T.pack ",") $ T.pack contents + pids::[PoolId] = read <$> T.unpack <$> sv + in + return $ LiquidationProceeds pids + + "DS" -> return $ UsingDS (read (contents)::DealStats) + "LiquidationSupportExp" -> let + sv = T.splitOn (T.pack ",") $ T.pack contents + in + return $ LiquidationSupportInt (read (T.unpack (head sv))::Balance) (read (T.unpack (sv!!1))::Balance) + "SupportDraw" -> return SupportDraw + "Draw" -> return LiquidationDraw + "Repay" -> return $ LiquidationRepay contents + "Accure" -> return SwapAccrue + "SettleIn" -> return $ SwapInSettle contents + "SettleOut" -> return $ SwapOutSettle contents + "PurchaseAsset" -> let + sv = T.splitOn (T.pack ",") $ T.pack contents + in + return $ PurchaseAsset (read (T.unpack (sv!!0))::String) (read (T.unpack (sv!!1))::Balance) + + "TxnDirection" -> return $ TxnDirection (read contents::BookDirection) + "FundWith" -> let + sv = T.splitOn (T.pack ",") $ T.pack contents + in + return $ FundWith (T.unpack (head sv)) (read (T.unpack (sv!!1))::Balance) +-- toJSON (IssuanceProceeds nb) = String $ T.pack $ "" + "IssuanceProceeds" -> return $ IssuanceProceeds contents + "Tag" -> return $ Tag contents + where + pat = "<(\\S+):(\\S+)>"::String + sr = (T.unpack t =~ pat)::[[String]] + tagName = head sr!!1::String + contents = head sr!!2::String + + +data DealStatType = RtnBalance + | RtnRate + | RtnBool + | RtnInt + deriving (Show,Eq,Ord,Read,Generic) + +getDealStatType :: DealStats -> DealStatType +getDealStatType (CumulativePoolDefaultedRateTill _ _) = RtnRate +getDealStatType (CumulativePoolDefaultedRate _) = RtnRate +getDealStatType (CumulativeNetLossRatio _) = RtnRate +getDealStatType BondFactor = RtnRate +getDealStatType (BondFactorOf _) = RtnRate +getDealStatType (PoolFactor _) = RtnRate +getDealStatType (FutureCurrentBondFactor _) = RtnRate +getDealStatType (FutureCurrentPoolFactor _ _) = RtnRate +getDealStatType (BondWaRate _) = RtnRate +getDealStatType (PoolWaRate _) = RtnRate +getDealStatType (BondRate _) = RtnRate +getDealStatType DivideRatio {} = RtnRate +getDealStatType AvgRatio {} = RtnRate +getDealStatType (DealStatRate _) = RtnRate +getDealStatType (Avg dss) = RtnRate +getDealStatType (Divide ds1 ds2) = RtnRate +getDealStatType (Multiply _) = RtnRate +getDealStatType (Factor _ _) = RtnRate +getDealStatType (PoolWaSpread _) = RtnRate + +getDealStatType (CurrentPoolBorrowerNum _) = RtnInt +getDealStatType (MonthsTillMaturity _) = RtnInt +getDealStatType ProjCollectPeriodNum = RtnInt +getDealStatType (DealStatInt _) = RtnInt + +getDealStatType (IsMostSenior _ _) = RtnBool +getDealStatType IsPaidOff {} = RtnBool +getDealStatType IsOutstanding {} = RtnBool +getDealStatType HasPassedMaturity {} = RtnBool +getDealStatType (TriggersStatus _ _)= RtnBool +getDealStatType (IsDealStatus _)= RtnBool +getDealStatType TestRate {} = RtnBool +getDealStatType (TestAny _ _) = RtnBool +getDealStatType (TestAll _ _) = RtnBool +getDealStatType (DealStatBool _) = RtnBool + +getDealStatType (Max dss) = getDealStatType (head dss) +getDealStatType (Min dss) = getDealStatType (head dss) +getDealStatType _ = RtnBalance + +dealStatType _ = RtnBalance + +data CustomDataType = CustomConstant Rational + | CustomCurve Ts + | CustomDS DealStats + deriving (Show,Ord,Eq,Read,Generic) + +opts :: JSONKeyOptions +opts = defaultJSONKeyOptions -- { keyModifier = toLower } + + +$(deriveJSON defaultOptions ''BondPricingMethod) +$(deriveJSON defaultOptions ''DealStatus) +$(deriveJSON defaultOptions ''CutoffType) +$(deriveJSON defaultOptions ''DealStatFields) +$(concat <$> traverse (deriveJSON defaultOptions) [''BookDirection, ''DealStats, ''PricingMethod, ''DealCycle, ''DateType, ''Period, + ''DatePattern, ''Table, ''BalanceSheetReport, ''BookItem, ''CashflowReport, ''Txn] ) + +instance ToJSONKey DateType where + toJSONKey = genericToJSONKey opts +instance FromJSONKey DateType where + fromJSONKey = FromJSONKeyTextParser $ \t -> + case T.splitOn " " t of + ["CustomExeDates", rest] -> pure $ CustomExeDates (T.unpack rest) + _ -> case readMaybe (T.unpack t) of + Just k -> pure k + Nothing -> fail ("Invalid key (DateType): " ++ show t++">>"++ show (T.unpack t)) + + + +$(deriveJSON defaultOptions ''RangeType) +$(deriveJSON defaultOptions ''PerCurve) +$(deriveJSON defaultOptions ''Pre) +$(deriveJSON defaultOptions ''CustomDataType) +$(deriveJSON defaultOptions ''ActionWhen) + +instance ToJSONKey ActionWhen where + toJSONKey = toJSONKeyText (T.pack . show) + +instance FromJSONKey ActionWhen where + fromJSONKey = FromJSONKeyTextParser $ \t -> + case T.splitOn " " t of + ["CustomWaterfall", rest] -> pure $ CustomWaterfall (T.unpack rest) + _ -> case readMaybe (T.unpack t) of + Just k -> pure k + Nothing -> fail ("Invalid key (Action When): " ++ show t++">>"++ show (T.unpack t)) + + +$(deriveJSON defaultOptions ''ResultComponent) +$(deriveJSON defaultOptions ''PriceResult) +$(deriveJSON defaultOptions ''CutoffFields) +$(deriveJSON defaultOptions ''HowToPay) + + + +instance ToJSONKey DealCycle where + toJSONKey = toJSONKeyText (T.pack . show) + +instance FromJSONKey DealCycle where + fromJSONKey = FromJSONKeyTextParser $ \t -> case readMaybe (T.unpack t) of + Just k -> pure k + Nothing -> fail ("Invalid key: " ++ show t) + + +instance ToJSONKey CutoffFields where + toJSONKey = toJSONKeyText (Text.pack . show) + +instance FromJSONKey CutoffFields where + fromJSONKey = FromJSONKeyTextParser $ \t -> case readMaybe (Text.unpack t) of + Just k -> pure k + Nothing -> fail ("Invalid key: " ++ show t) + + +newtype MyRatio = MyRatio (Ratio Integer) + +instance ToJSON MyRatio where + toJSON (MyRatio r) = case fromRationalRepetend Nothing r of + Left (sci, _) -> toJSON $ formatScientific Fixed (Just 8) sci + Right (sci, rep) -> toJSON $ formatScientific Fixed (Just 8) sci + +instance Show MyRatio where + show (MyRatio r) = case fromRationalRepetend Nothing r of + Left (sci, _) -> show $ formatScientific Fixed (Just 8) sci + Right (sci, rep) -> show $ formatScientific Fixed (Just 8) sci + +$(deriveJSON defaultOptions ''Index) +$(deriveJSON defaultOptions ''DayCount) +$(deriveJSON defaultOptions ''Threshold) +instance ToJSONKey Threshold where + toJSONKey = genericToJSONKey opts +instance FromJSONKey Threshold where + fromJSONKey = genericFromJSONKey opts + + +$(deriveJSON defaultOptions ''RateAssumption) +$(deriveJSON defaultOptions ''Direction) + +makePrisms ''Txn +$(concat <$> traverse (deriveJSON defaultOptions) [''Limit] ) diff --git a/src/Util.hs b/src/Util.hs new file mode 100644 --- /dev/null +++ b/src/Util.hs @@ -0,0 +1,475 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Util + (mulBR,mulBIR,mulBI,mulBInt,mulBInteger,lastN + ,getValByDate,getValByDates,scaleUpToOne + ,divideBB,getIntervalFactorsDc + ,multiplyTs,zipTs,getTsVals,getTsSize,divideBI,mulIR, daysInterval + ,replace,paddingDefault, capWith, getTsDates + ,shiftTsByAmt,calcWeightBalanceByDates + ,maximum',minimum',roundingBy,roundingByM + ,floorWith,slice,toPeriodRateByInterval, dropLastN, zipBalTs + ,lastOf,findBox,safeDivide', safeDiv + ,safeDivide,lstToMapByFn,paySequentially,payProRata,mapWithinMap + ,payInMap,adjustM,lookupAndApply,lookupAndUpdate,lookupAndApplies + ,lookupInMap,selectInMap,scaleByFstElement + ,lookupTuple6 ,lookupTuple7,diffNum + -- for debug + ,debugOnDate,paySeqM,splitByLengths + ) + where +import qualified Data.Time as T +import qualified Data.Map as Map +import Data.List +import Data.Fixed +import Data.Ratio ((%)) +import Data.Ix +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as S +import Lib +import Types +import DateUtil + +import Numeric.Limits (infinity) +import Text.Printf +import Control.Exception + +import Data.Time (addDays) +import Debug.Trace +debug = flip trace + +mulBR :: Balance -> Rate -> Balance +mulBR b r = fromRational $ toRational b * r + +mulBIR :: Balance -> IRate -> Balance +mulBIR b r = fromRational $ toRational b * toRational r + +mulIR :: Int -> Rational -> Rational +mulIR i r = toRational i * r + +mulIntegerR :: Integer -> Rational -> Rational +mulIntegerR i r = toRational i * r + +mulBInt :: Balance -> Int -> Rational +mulBInt b i = toRational b * toRational i + +mulBInteger :: Balance -> Integer -> Rational +mulBInteger b i = mulBInt b (fromInteger i) + +mulBI :: Balance -> IRate -> Amount +mulBI bal r = fromRational $ toRational bal * toRational r + +divideBI :: Balance -> Int -> Balance +divideBI b i = fromRational $ toRational b / toRational i + +divideBB :: Balance -> Balance -> Rational +divideBB b1 b2 = toRational b1 / toRational b2 + +safeDivide :: RealFloat a => a -> a -> a +safeDivide _ 0 = Numeric.Limits.infinity +safeDivide x y = x / y + + +safeDiv :: Rational -> Rational -> Maybe Rational +safeDiv _ 0 = Nothing +safeDiv x y = Just $ x / y + +zipLeftover :: [a] -> [a] -> [a] +zipLeftover [] [] = [] +zipLeftover xs [] = xs +zipLeftover [] ys = ys +zipLeftover (x:xs) (y:ys) = zipLeftover xs ys + +lastN :: Int -> [a] -> [a] +lastN n xs = zipLeftover (drop n xs) xs + +tsPointVal :: TsPoint a -> a +tsPointVal (TsPoint d v) = v + +getValByDate :: Ts -> CutoffType -> Date -> Rational + +getValByDate (LeftBalanceCurve dps) ct d + = case find (\(TsPoint _d _) -> (cmpFun ct) _d d) (reverse dps) of + Just (TsPoint _d v) -> toRational v + Nothing -> 0 + where + cmpFun Inc = (<=) + cmpFun Exc = (<) + +getValByDate (BalanceCurve dps) Exc d + = case find (\(TsPoint _d _) -> d > _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v + Nothing -> 0 + +getValByDate (BalanceCurve dps) Inc d + = case find (\(TsPoint _d _) -> d >= _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v + Nothing -> 0 + +getValByDate (FloatCurve dps) Exc d + = case find (\(TsPoint _d _) -> d > _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> 0 -- `debug` ("Getting 0 ") + +getValByDate (FloatCurve dps) Inc d + = case find (\(TsPoint _d _) -> d >= _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> 0 -- `debug` ("Getting 0 ") + +getValByDate (IRateCurve dps) Exc d + = case find (\(TsPoint _d _) -> d > _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> 0 -- `debug` ("Getting 0 ") + +getValByDate (IRateCurve dps) Inc d + = case find (\(TsPoint _d _) -> d >= _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> 0 -- `debug` ("Getting 0 ") + +getValByDate (RatioCurve dps) Exc d + = case find (\(TsPoint _d _) -> d > _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> 0 -- `debug` ("Getting 0 ") + +getValByDate (RatioCurve dps) Inc d + = case find (\(TsPoint _d _) -> d >= _d) (reverse dps) of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> 0 -- `debug` ("Getting 0 ") + +getValByDate (ThresholdCurve dps) Inc d + = case find (\(TsPoint _d _) -> d <= _d) dps of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> tsPointVal $ last dps --`debug` ("Not found in gvbd") + +getValByDate (ThresholdCurve dps) Exc d + = case find (\(TsPoint _d _) -> d < _d) dps of + Just (TsPoint _d v) -> toRational v -- `debug` ("Getting rate "++show(_d)++show(v)) + Nothing -> tsPointVal $ last dps --`debug` ("Not found in gvbd") + +getValByDate (FactorCurveClosed dps ed) Exc d + = case find (\(TsPoint _d _) -> d > _d) (reverse dps) of + Just found@(TsPoint _found_d _found_v) -> + if d >= ed then + 1.0 + else + _found_v + Nothing -> 1.0 + +getValByDate (PricingCurve dps) _ d + = case (d>=lday,d<=fday) of + (True,_) -> tsPointVal $ last dps + (_,True) -> tsPointVal $ head dps + _ -> let + rindex = fromMaybe 0 $findIndex (\(TsPoint _dl _) -> ( _dl > d )) dps + rdp@(TsPoint _dr _rv) = dps!!rindex + ldp@(TsPoint _dl _lv) = dps!!(pred rindex) + leftDistance = toRational $ daysBetween _dl d -- `debug` ("LEFT"++show d) + distance = toRational $ daysBetween _dl _dr -- `debug` ("TOTAL Horizion"++show _dl++show _dr) + vdistance = _rv - _lv -- ("DIST") + in + toRational $ _lv + (vdistance * leftDistance) / distance + -- `debug` ("PricingCurve get Val: D "++ show _lv++">>"++ show vdistance++">>"++ show leftDistance++">>"++ show distance) + where + fday = getDate $ head dps + lday = getDate $ last dps + +getValByDate a b c = error $ "Not match for curve type"++show a++" > "++show b++" > " ++show c + + +getIndexRateByDates :: RateAssumption -> [Date] -> [IRate] +getIndexRateByDates (RateCurve idx rc) ds = fromRational <$> getValByDates rc Inc ds +getIndexRateByDates (RateFlat idx r) ds = replicate (length ds) r + +getValByDates :: Ts -> CutoffType -> [Date] -> [Rational] +getValByDates rc ct = map (getValByDate rc ct) + +getTsVals :: Ts -> [Rational] +getTsVals (FloatCurve ts) = [ v | (TsPoint d v) <- ts ] +getTsVals (RatioCurve ts) = [ v | (TsPoint d v) <- ts ] +getTsVals (BalanceCurve ts) = [ toRational v | (TsPoint d v) <- ts ] +getTsVals (IRateCurve ts) = [ toRational v | (TsPoint d v) <- ts ] + +getTsDates :: Ts -> [Date] +getTsDates (IRateCurve tps) = map getDate tps +getTsDates (RatioCurve tps) = map getDate tps +getTsDates (FloatCurve tps) = map getDate tps +getTsDates (PricingCurve tps) = map getDate tps +getTsDates (BalanceCurve tps) = map getDate tps + +getTsSize :: Ts -> Int +getTsSize ts = length (getTsVals ts) + +zipTs :: [Date] -> [Rational] -> Ts +zipTs ds rs = FloatCurve [ TsPoint d r | (d,r) <- zip ds rs ] + +zipBalTs :: [Date] -> [Balance] -> Ts +zipBalTs ds rs = BalanceCurve [ TsPoint d r | (d,r) <- zip ds rs ] + +-- ^ multiply 1st Ts with values from 2nd Ts +multiplyTs :: CutoffType -> Ts -> Ts -> Ts +multiplyTs ct (FloatCurve ts1) ts2 + = FloatCurve [(TsPoint d (v * (getValByDate ts2 ct d))) | (TsPoint d v) <- ts1 ] + +multiplyTs ct (IRateCurve ts1) ts2 + = IRateCurve [(TsPoint d (v * (fromRational (getValByDate ts2 ct d)))) | (TsPoint d v) <- ts1 ] + +multiplyTs c a b = error $ "Failed to match : multiplyTs"++ show c ++ show a ++ show b + + +-- | swap a value in list with index supplied +replace :: [a] -> Int -> a -> [a] +replace xs i e + | i > pred (length xs) = error $ "index:"++show i++" is greater than size"++ show (length xs) + | otherwise = case splitAt i xs of + (before, _:after) -> before ++ e: after + _ -> xs + +-- ^ padding default value to end of list ,make it length with N +paddingDefault :: a -> [a] -> Int -> [a] +paddingDefault x xs s + | length xs > s = take s xs + | otherwise = xs ++ replicate (s - length xs) x + +capWith :: Ord a => a -> [a] -> [a] +capWith cap xs = [ min cap x | x <- xs ] + +floorWith :: Ord a => a -> [a] -> [a] +floorWith floor xs = [ max x floor | x <- xs] + +diffNum :: Num a => [a] -> [a] +diffNum xs = zipWith (-) (init xs) (tail xs) + +scaleByFstElement :: forall a. Fractional a => a -> [a] -> [a] +scaleByFstElement x [] = [] +scaleByFstElement y (b:xs) = + let + s = y/b + in + y:[ x * s | x <- xs ] + + +debugLine :: Show a => [a] -> String +debugLine xs = "" + +lastOf:: [a] -> (a->Bool) -> Maybe a +lastOf [] fn = Nothing +lastOf xs fn = + let + l = last xs + in + if fn l then + Just l + else + lastOf (init xs) fn + +shiftTsByAmt :: Ts -> Rational -> Ts +shiftTsByAmt (IRateCurve tps) delta + = IRateCurve $ [ TsPoint d (fromRational delta+v) | TsPoint d v <- tps ] + +shiftTsByAmt _ts delta = _ts + +assert1 :: Bool -> a -> String -> a +assert1 False x msg = error msg +assert1 _ x _ = x + + +-- ^ get a weighted average balance on year basis with a dayCount required +calcWeightBalanceByDates :: DayCount -> [Balance] -> [Date] -> Balance +calcWeightBalanceByDates dc bals ds + = assert1 + (succ bs_length == ds_length) + (sum $ zipWith mulBR bals weights) + "calcWeightBalanceByDates: bs and ds should be same length" + where + bs_length = length bals + ds_length = length ds + weights = getIntervalFactorsDc dc ds + +testSumToOne :: [Rate] -> Bool +testSumToOne rs = sum rs == 1.0 + +maximum' :: Ord a => [a] -> a +maximum' = foldr1 (\x y ->if x >= y then x else y) + +minimum' :: Ord a => [a] -> a +minimum' = foldr1 (\x y ->if x >= y then y else x) + +roundingBy :: (Num a,Fractional a, RealFrac a) => RoundingBy a -> a -> a +roundingBy (RoundFloor x) n = x * fromIntegral (floor (n/x) :: Integer) +roundingBy (RoundCeil x) n = x * fromIntegral (ceiling (n/x) :: Integer) + +roundingByM :: (Fractional a,RealFrac a) => Maybe (RoundingBy a) -> a -> a +roundingByM Nothing x = x +roundingByM (Just rb) x = roundingBy rb x + +slice :: Int -> Int -> [a] -> [a] +slice from to xs = take (to - from ) (drop from xs) + +dropLastN :: Int -> [a] -> [a] +dropLastN n xs = slice 0 (length xs - n) xs + +-- ^ convert annual rate (in 365 days) to period rate by interval days +toPeriodRateByInterval :: Rate -> Int -> Rate +toPeriodRateByInterval annualRate days + = toRational $ 1 - fromRational (1-annualRate) ** (fromIntegral days / 365) -- `debug` ("days>>"++show days++"DIV"++ show ((fromIntegral days) / 365)) + +scaleUpToOne :: [Rational] -> [Rational] +scaleUpToOne rs = + let + s = 1 / sum rs + in + (s *) <$> rs + + +findBox :: (Ord a,Num a) => (CutoffType,CutoffType) -> a -> [(a,a)] -> Maybe (a,a) +findBox _ x [] = Nothing +findBox (Inc,Inc) x ((l,h):xs) + | x >= l && x <= h = Just (l,h) + | otherwise = findBox (Inc,Inc) x xs + +findBox (Exc,Inc) x ((l,h):xs) + | x > l && x <= h = Just (l,h) + | otherwise = findBox (Exc,Inc) x xs + +findBox (Inc,Exc) x ((l,h):xs) + | x >= l && x < h = Just (l,h) + | otherwise = findBox (Inc,Exc) x xs + +findBox (Exc,Exc) x ((l,h):xs) + | x >= l && x < h = Just (l,h) + | otherwise = findBox (Exc,Exc) x xs + + +safeDivide' :: (Eq a, Fractional a, Real a) => a -> a -> Rational +safeDivide' _ 0 = 10000000000000000000000000000000000000000000000000000 +safeDivide' x y = toRational x / toRational y + + +lstToMapByFn :: (a -> String) -> [a] -> M.Map String a +lstToMapByFn fn lst = + let + ks = fn <$> lst + in + M.fromList $ zip ks lst + +paySeqM :: Date -> Amount -> (a->Balance) -> (Amount->a->Either String a) -> Either String [a] -> [a] -> Either String ([a],Amount) +paySeqM d amt getDueAmt payFn paidList [] + = do + pList <- paidList + return (reverse pList, amt) +paySeqM d 0 getDueAmt payFn paidList tobePaidList + = do + pList <- paidList + return (reverse pList++tobePaidList, 0) +paySeqM d amt getDueAmt payFn paidList (l:tobePaidList) + = do + let dueAmt = getDueAmt l + let actualPaidOut = min amt dueAmt + let remainAmt = amt - actualPaidOut + paidL <- payFn actualPaidOut l + paidList_ <- paidList + paySeqM d remainAmt getDueAmt payFn (Right $ paidL:paidList_) tobePaidList + +paySequentially :: Date -> Amount -> (a->Balance) -> (Amount->a->a) -> [a] -> [a] -> ([a],Amount) +paySequentially d amt getDueAmt payFn paidList [] + = (reverse paidList, amt) +paySequentially d 0 getDueAmt payFn paidList tobePaidList + = (reverse paidList++tobePaidList, 0) +paySequentially d amt getDueAmt payFn paidList (l:tobePaidList) + = let + dueAmt = getDueAmt l + actualPaidOut = min amt dueAmt + remainAmt = amt - actualPaidOut + paidL = payFn actualPaidOut l + in + paySequentially d remainAmt getDueAmt payFn (paidL:paidList) tobePaidList + +payProRata :: Date -> Amount -> (a->Balance) -> (Amount->a->a) -> [a] -> ([a],Amount) +payProRata d amt getDueAmt payFn tobePaidList + = let + dueAmts = getDueAmt <$> tobePaidList + totalDueAmt = sum dueAmts + actualPaidOut = min amt totalDueAmt + remainAmt = amt - actualPaidOut + + allocAmt = prorataFactors dueAmts actualPaidOut + + paidList = [ payFn amt l | (amt,l) <- zip allocAmt tobePaidList ] + in + (paidList, remainAmt) + +payInMap :: Date -> Balance -> (a->Balance) -> (Balance->a->a)-> [String] + -> HowToPay -> Map.Map String a -> Map.Map String a +payInMap d amt getDueFn payFn objNames how inputMap + = let + objsToPay = (inputMap Map.!) <$> objNames + dueAmts = getDueFn <$> objsToPay + totalDueAmt = sum dueAmts + actualPaidOut = min totalDueAmt amt + allocatedPayAmt = case how of + ByProRata -> prorataFactors dueAmts actualPaidOut + BySequential -> paySeqLiabilitiesAmt amt dueAmts + paidObjs = [ payFn amt l | (amt,l) <- zip allocatedPayAmt objsToPay ] + in + (Map.fromList $ zip objNames paidObjs) <> inputMap + +mapWithinMap :: Ord k => (a -> a) -> [k] -> Map.Map k a -> Map.Map k a +mapWithinMap fn ks m = foldr (Map.adjust fn) m ks + +adjustM :: (Ord k, Applicative m) => (a -> m a) -> k -> Map.Map k a -> m (Map.Map k a) +adjustM f = Map.alterF (traverse f) + +-- ^ lookup and apply a function to a single value in a map ,return a value +lookupAndApply :: Ord k => (a -> b) -> String -> k -> Map.Map k a -> Either String b +lookupAndApply f errMsg key m = + case Map.lookup key m of + Nothing -> Left errMsg + Just a -> Right $ f a + +-- ^ lookup and apply a function to values in a map ,return a list +lookupAndApplies :: Ord k => (a -> b) -> String -> [k] -> Map.Map k a -> Either String [b] +lookupAndApplies f errMsg keys m + = sequenceA $ (\x -> lookupAndApply f errMsg x m) <$> keys + +lookupAndUpdate :: (Show k, Ord k) => (a -> a) -> String -> [k] -> Map.Map k a -> Either String (Map.Map k a) +lookupAndUpdate f errMsg keys m + | S.isSubsetOf inputKs mapKs = Right $ mapWithinMap f keys m + | otherwise = Left $ errMsg++":Missing keys, valid range "++ show mapKs ++ "But got:" ++ show inputKs + where + inputKs = S.fromList keys + mapKs = Map.keysSet m + +lookupInMap :: (Show k, Ord k) => String -> [k] -> Map.Map k a -> Either String (Map.Map k a) +lookupInMap = lookupAndUpdate id + +selectInMap :: (Show k, Ord k) => String -> [k] -> Map.Map k a -> Either String (Map.Map k a) +selectInMap errMsg keys m + | S.isSubsetOf inputKs mapKs = Right $ Map.filterWithKey (\k _ -> S.member k inputKs) m + | otherwise = Left $ errMsg++":Missing keys, valid range "++ show mapKs ++ "But got:" ++ show inputKs + where + inputKs = S.fromList keys + mapKs = Map.keysSet m + +lookupTuple6 :: (Ord k) => (k, k, k, k, k, k) -> Map.Map k v -> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v) +lookupTuple6 (k1, k2, k3, k4, k5, k6) m = + ( Map.lookup k1 m , Map.lookup k2 m , Map.lookup k3 m , Map.lookup k4 m , Map.lookup k5 m , Map.lookup k6 m) + +lookupTuple7 :: (Ord k) => (k, k, k, k, k, k, k) -> Map.Map k v -> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v) +lookupTuple7 (k1, k2, k3, k4, k5, k6, k7) m = + ( Map.lookup k1 m , Map.lookup k2 m , Map.lookup k3 m , Map.lookup k4 m , Map.lookup k5 m , Map.lookup k6 m, Map.lookup k7 m) + + +splitByLengths :: Num a => [a] -> [Int] -> [[a]] +splitByLengths xs ns = go xs ns + where + go _ [] = [] + go [] _ = [] + go xs (n:ns) = take n xs : go (drop n xs) ns + +----- DEBUG/PRINT +debugOnDate :: Date -> Date -> Date -> String +debugOnDate d1 d2 d + | (d <= d2) && (d >= d1) = "Date:"++show d + | otherwise = "" diff --git a/src/Validation.hs b/src/Validation.hs new file mode 100644 --- /dev/null +++ b/src/Validation.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} + +module Validation () + where + +import Deal.DealBase +import Types +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe + +import qualified Waterfall as W +import qualified CreditEnhancement as CE +import qualified Liability as L +import qualified Accounts as A +import qualified Expense as F +import qualified Asset as P +import qualified Assumptions as AP +import qualified InterestRate as IR + +import Control.Lens hiding (element) +import Control.Lens.TH + +import Data.Maybe +import qualified Assumptions as A + + +import Debug.Trace +debug = flip trace + + + +-- valAssetRunReq :: (IR.UseRate a,P.Asset a) => TestDeal a -> AP.NonPerfAssumption -> (Bool,[ResultComponent]) +-- valAssetRunReq t@TestDeal{accounts = accMap} assump@A.NonPerfAssumption{A.interest = intM, A.issueBondSchedule = mIssuePlan} +-- = let diff --git a/src/Waterfall.hs b/src/Waterfall.hs new file mode 100644 --- /dev/null +++ b/src/Waterfall.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} + +module Waterfall + (PoolSource(..),Action(..),DistributionSeq(..),CollectionRule(..) + ,ActionWhen(..),BookType(..),ExtraSupport(..),PayOrderBy(..)) + where + +import Language.Haskell.TH +import Data.Aeson hiding (json) +import qualified Data.Text as T +import Text.Read (readMaybe) +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Hashable +import Data.Fixed +import GHC.Generics + +import Types +import Revolving +import Stmt (TxnComment(..)) +import qualified Lib as L +import qualified Call as C +import qualified CreditEnhancement as CE +import qualified Hedge as HE +import Ledger (LedgerName) + + +data BookType = PDL BookDirection DealStats [(LedgerName,DealStats)] -- Reverse PDL Debit reference, [(name,cap reference)] + | ByDS LedgerName BookDirection DealStats -- Book amount equal to a formula/deal stats + | Till LedgerName BookDirection DealStats -- Book amount till deal stats + deriving (Show,Generic,Eq,Ord) + +data ExtraSupport = SupportAccount AccountName (Maybe BookLedger) -- ^ if there is deficit, draw another account to pay the shortfall + | SupportLiqFacility CE.LiquidityProviderName -- ^ if there is deficit, draw facility's available credit to pay the shortfall + | MultiSupport [ExtraSupport] -- ^ if there is deficit, draw multiple supports (by sequence in the list) to pay the shortfall + | WithCondition Pre ExtraSupport -- ^ support only available if Pre is true + deriving (Show,Generic,Eq,Ord) + +data PayOrderBy = ByName + | ByProRataCurBal + | ByCurrentRate + | ByMaturity + | ByStartDate + | ByCustomNames [String] + -- | InverseSeq PayOrderBy + deriving (Show,Generic,Eq,Ord) + +type BookLedger = (BookDirection, LedgerName) +type BookLedgers = (BookDirection, [LedgerName]) + +data Action = + -- Accounts + Transfer (Maybe Limit) AccountName AccountName (Maybe TxnComment) + | TransferAndBook (Maybe Limit) AccountName AccountName BookLedger (Maybe TxnComment) + | TransferMultiple [(Maybe Limit, AccountName)] AccountName (Maybe TxnComment) + -- Fee + | CalcFee [FeeName] -- ^ calculate fee due amount in the fee names + | PayFee (Maybe Limit) AccountName [FeeName] (Maybe ExtraSupport) -- ^ pay fee with cash from account with optional limit or extra support + | PayFeeBySeq (Maybe Limit) AccountName [FeeName] (Maybe ExtraSupport) -- ^ pay fee with cash from account with optional limit or extra support + | CalcAndPayFee (Maybe Limit) AccountName [FeeName] (Maybe ExtraSupport) -- ^ combination of CalcFee and PayFee + | PayFeeResidual (Maybe Limit) AccountName FeeName -- ^ pay fee regardless fee due amount + -- Bond - Interest + | CalcBondInt [BondName] + | CalcBondIntBy BondName DealStats DealStats -- ^ calculate interest due amount in the bond names,with optional balance and rate + | PayIntOverInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay interest over interest only + | PayInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay interest with cash from the account with optional limit or extra support + | PayIntAndBook (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) BookLedger -- ^ pay interest with cash from the account with optional limit or extra support + | PayIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ with sequence + | PayIntOverIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay interest over interest only with sequence + | AccrueAndPayInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ combination of CalcInt and PayInt + | AccrueAndPayIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ with sequence + | PayIntResidual (Maybe Limit) AccountName BondName -- ^ pay interest to bond regardless interest due + | PayIntByRateIndex (Maybe Limit) AccountName [BondName] Int (Maybe ExtraSupport) -- ^ pay interest to bond by index + | PayIntByRateIndexBySeq (Maybe Limit) AccountName [BondName] Int (Maybe ExtraSupport) -- ^ pay interest to bond by index + -- Bond - Principal + | CalcBondPrin (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ calculate principal due amount in the bond names + | CalcBondPrin2 (Maybe Limit) [BondName] -- ^ calculate principal due amount in the bond names + | PayPrinWithDue AccountName [BondName] (Maybe ExtraSupport) -- ^ pay principal to bond till due amount + | PayPrin (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay principal to bond via pro-rata + | PayPrinBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay principal to bond via sequence + | PayPrinResidual AccountName [BondName] -- ^ pay principal regardless predefined balance schedule + | PayIntPrinBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay int & prin to bonds sequentially + | AccrueAndPayIntPrinBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) + -- Bond Group + | PayPrinGroup (Maybe Limit) AccountName BondName PayOrderBy (Maybe ExtraSupport) -- ^ pay bond group with cash from account with optional limit or extra support + | AccrueIntGroup [BondName] + | PayIntGroup (Maybe Limit) AccountName BondName PayOrderBy (Maybe ExtraSupport) -- ^ pay bond group with cash from account with optional limit or extra support + | AccrueAndPayIntGroup (Maybe Limit) AccountName BondName PayOrderBy (Maybe ExtraSupport) + -- Bond - Balance + | WriteOff (Maybe Limit) BondName + | WriteOffAndBook (Maybe Limit) BondName BookLedger + | WriteOffBySeq (Maybe Limit) [BondName] + | WriteOffBySeqAndBook (Maybe Limit) [BondName] BookLedger + | FundWith (Maybe Limit) AccountName BondName -- ^ extra more funds from bond and deposit cash to account + -- Pool/Asset change + | BuyAsset (Maybe Limit) PricingMethod AccountName (Maybe PoolId) -- ^ buy asset from revolving assumptions using funds from account + | BuyAssetFrom (Maybe Limit) PricingMethod AccountName (Maybe String) (Maybe PoolId) -- ^ buy asset from specific pool, with revolving assumptions using funds from account + | LiquidatePool PricingMethod AccountName (Maybe [PoolId]) -- ^ sell all assets and deposit proceeds to account + -- TODO include a limit for LIquidatePool + -- Liquidation support + | LiqSupport (Maybe Limit) CE.LiquidityProviderName CE.LiqDrawType [String] -- ^ draw credit and deposit to account/fee/bond interest/principal + | LiqRepay (Maybe Limit) CE.LiqRepayType AccountName CE.LiquidityProviderName -- ^ repay liquidity facility + | LiqYield (Maybe Limit) AccountName CE.LiquidityProviderName -- ^ repay compensation to liquidity facility + | LiqAccrue [CE.LiquidityProviderName] -- ^ accure premium/due interest of liquidity facility + -- Rate Swap + | SwapAccrue CeName -- ^ calculate the net amount of swap manually + | SwapReceive AccountName CeName -- ^ receive amount from net amount of swap and deposit to account + | SwapPay AccountName CeName -- ^ pay out net amount from account + | SwapSettle AccountName CeName -- ^ pay & receive net amount of swap with account + -- RateCap + | CollectRateCap AccountName CeName -- ^ collect cash from rate cap and deposit to account + -- Record booking + | BookBy BookType -- ^ book an ledger with book types + -- Pre + | ActionWithPre Pre [Action] -- ^ execute actions if 
 is true 
+            | ActionWithPre2 Pre [Action] [Action]  -- ^ execute action1 if 
 is true ,else execute action2 
+            -- Trigger
+            | RunTrigger DealCycle [String]        -- ^ update the trigger status during the waterfall execution
+            -- Debug
+            | WatchVal (Maybe String) [DealStats]  -- ^ inspect vals during the waterfall execution
+            | Placeholder (Maybe String)
+            | ChangeStatus (Maybe Pre) DealStatus  -- change deal status
+            deriving (Show,Generic,Eq,Ord)
+
+type DistributionSeq = [Action]
+
+data CollectionRule = Collect (Maybe [PoolId]) PoolSource AccountName                   -- ^ collect a pool source from pool collection and deposit to an account
+                    | CollectByPct (Maybe [PoolId]) PoolSource [(Rate,AccountName)]     -- ^ collect a pool source from pool collection and deposit to multiple accounts with percentages
+                    deriving (Show,Generic,Eq,Ord)
+
+$(deriveJSON defaultOptions ''BookType)
+$(deriveJSON defaultOptions ''ExtraSupport)
+$(deriveJSON defaultOptions ''PayOrderBy)
+$(deriveJSON defaultOptions ''Action)
+$(deriveJSON defaultOptions ''CollectionRule)
diff --git a/test/DealTest/DealTest.hs b/test/DealTest/DealTest.hs
new file mode 100644
--- /dev/null
+++ b/test/DealTest/DealTest.hs
@@ -0,0 +1,148 @@
+module DealTest.DealTest(baseCase,baseTests,emptyCase)
+
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Deal
+
+import qualified Accounts as A
+import qualified Stmt as S
+import qualified Asset as Ast 
+import qualified Pool as P
+import qualified AssetClass.Mortgage as ACM
+import qualified AssetClass.AssetBase as AB
+import qualified Expense as F
+import qualified Deal.DealBase as D
+import qualified Deal as DR
+import qualified Liability as L
+import qualified Waterfall as W
+import qualified Cashflow as CF
+import qualified Assumptions as AP
+import qualified Call as C
+import InterestRate
+import qualified CreditEnhancement as CE
+import qualified Triggers as Trg
+import Lib
+import Types
+
+import qualified Data.Map as Map
+import qualified Data.Time as T
+import qualified Data.Set as S
+import Numeric.Lens (base)
+import qualified Types as P
+
+dummySt = (0,Lib.toDate "19000101",Nothing)
+
+emptyCase = D.TestDeal {
+  D.name = "empty case"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = Map.empty
+  ,D.fees = Map.empty
+  ,D.bonds = Map.empty
+  ,D.pool = D.MultiPool $ Map.fromList [(PoolConsol, (P.Pool {P.assets=[]}))] 
+  ,D.waterfall = Map.empty
+  ,D.collects = []
+}
+
+baseCase = D.TestDeal {
+  D.name = "base case"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = (Map.fromList
+  [("General", (A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing }))])
+  ,D.fees = Map.empty
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndDuePrin=0.0
+                             ,L.bndStepUp = Nothing
+                             ,L.bndDueInt=0.0
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndStmt=Nothing
+                             ,L.bndDueIntOverInt = 0})
+                         ]
+           )
+  ,D.pool = D.MultiPool $
+              (Map.fromList [(PoolConsol, (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}
+                                         4000
+                                         0.085
+                                         60
+                                         Nothing
+                                         AB.Current]
+                               ,P.futureCf=Nothing
+                               ,P.asOfDate = T.fromGregorian 2022 1 1
+                               ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance, 4000)]
+                               ,P.extendPeriods = Nothing}))])
+   ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                 (W.PayInt Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["A"] Nothing)
+   ])]
+ ,D.collects = [W.Collect Nothing W.CollectedInterest "General"
+             ,W.Collect Nothing W.CollectedPrincipal "General"]
+ ,D.liqProvider = Nothing
+ ,D.rateCap = Nothing
+ ,D.triggers = Nothing
+ ,D.ledgers = Nothing
+ ,D.stats = (Map.empty,Map.empty,Map.empty,Map.empty)
+}
+
+baseTests = 
+  let 
+    nonRunAssump = (AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just [AP.InspectPt MonthEnd (FutureCurrentPoolBalance Nothing)]) Nothing Nothing Nothing Nothing Nothing Nothing)
+    (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 ] 
+  in 
+   testGroup "Base Deal Test" 
+   [ testCase "empty pool flow" $
+     assertEqual "empty pool flow"
+     0
+     -- (P.futureCf (D.pool baseCase))
+     0
+     -- https://docs.google.com/spreadsheets/d/1gmz8LOB01qqfPldquyDn43PJJ1MI016tS-JS5KW3SvM/edit?gid=1325808922#gid=1325808922
+     ,testCase "pool current balance (run time)" $
+     assertEqual "pool current balance (run time)"
+      (InspectBal (toDate "20220101") (FutureCurrentPoolBalance Nothing) 4000)
+      (inspects!!0)
+     ,testCase "pool current balance (run time 1)" $
+     assertEqual "pool current balance (run time 1)"
+      (InspectBal (toDate "20220131") (FutureCurrentPoolBalance Nothing) 4000)
+      (inspects!!1)
+     ,testCase "pool current balance (run time 2)" $
+     assertEqual "pool current balance (run time 2)"
+      (InspectBal (toDate "20220228") (FutureCurrentPoolBalance Nothing) 3946.27)
+      (inspects!!2)
+     ,testCase "pool current balance (run time 60)" $
+     assertEqual "pool current balance (run time 60)"
+      (InspectBal (toDate "20270131") (FutureCurrentPoolBalance Nothing) 0.0)
+      (inspects!!61)
+   ]
+
diff --git a/test/DealTest/MultiPoolDealTest.hs b/test/DealTest/MultiPoolDealTest.hs
new file mode 100644
--- /dev/null
+++ b/test/DealTest/MultiPoolDealTest.hs
@@ -0,0 +1,132 @@
+module DealTest.MultiPoolDealTest(baseCase,mPoolbaseTests)
+
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Deal
+
+import qualified Accounts as A
+import qualified Stmt as S
+import qualified Asset as Ast 
+import qualified Pool as P
+import qualified AssetClass.Mortgage as ACM
+import qualified AssetClass.AssetBase as AB
+import qualified Expense as F
+import qualified Deal.DealBase as D
+import qualified Deal as DR
+import qualified Liability as L
+import qualified Waterfall as W
+import qualified Cashflow as CF
+import qualified Assumptions as AP
+import qualified Call as C
+import InterestRate
+import qualified CreditEnhancement as CE
+import qualified Triggers as Trg
+import Lib
+import Types
+
+import qualified Data.Map as Map
+import qualified Data.Time as T
+import qualified Data.Set as S
+
+import Debug.Trace
+debug = flip trace
+
+dummySt = (0,Lib.toDate "19000101",Nothing)
+
+multiPool = Map.fromList [(PoolName "PoolA",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}
+                                                                   1000 0.085 60 Nothing AB.Current]
+                                                      ,P.futureCf= Nothing
+                                                      ,P.asOfDate = T.fromGregorian 2022 1 1
+                                                      ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,1000)]
+                                                      ,P.extendPeriods = Nothing
+                                                      })
+                         ,(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=Nothing
+                                                        ,P.asOfDate = T.fromGregorian 2022 1 1
+                                                        ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,3000)]
+                                                        ,P.extendPeriods = Nothing}))]
+
+
+baseCase = D.TestDeal {
+  D.name = "base case"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = (Map.fromList
+  [("General", (A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing }))])
+  ,D.fees = Map.empty
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndDuePrin=0.0
+                             ,L.bndDueInt=0.0
+                             ,L.bndStepUp = Nothing
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndDueIntOverInt = 0
+                             ,L.bndStmt=Nothing})
+                         ]
+           )
+  ,D.pool = D.MultiPool multiPool 
+   ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                 (W.PayInt Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["A"] Nothing)
+   ])]
+ ,D.collects = [W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedInterest "General"
+               ,W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedPrincipal "General"
+             ]
+ ,D.liqProvider = Nothing
+ ,D.rateCap = Nothing
+ ,D.triggers = Nothing
+ ,D.ledgers = Nothing
+ ,D.stats = (Map.empty,Map.empty,Map.empty,Map.empty)
+}
+
+mPoolbaseTests = 
+  let 
+    inspectVars = [AP.InspectRpt MonthEnd [FutureCurrentPoolBalance Nothing
+                                          ,FutureCurrentPoolBalance (Just [PoolName "PoolA"])
+                                          ,FutureCurrentPoolBalance (Just [PoolName "PoolB"])
+                                          ,FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])]
+                  ]
+    nonRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing (Just inspectVars) Nothing Nothing Nothing Nothing Nothing Nothing
+    (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 ] 
+  in 
+   testGroup "Multi Pool Deal Test" 
+   [testCase "pool current balance (run time)" $
+     assertEqual "pool current balance (run time)"
+      (InspectBal (toDate "20220101") (FutureCurrentPoolBalance Nothing) 4000)
+      (inspects!!0)
+     ,testCase "pool current balance (run time)" $
+     assertEqual "pool current balance (run time)"
+      (InspectBal (toDate "20220101") (FutureCurrentPoolBalance (Just [PoolName "PoolA"])) 1000)
+      (inspects!!1)
+     ,testCase "pool current balance (run time)" $
+     assertEqual "pool current balance (run time)"
+      (InspectBal (toDate "20220101") (FutureCurrentPoolBalance (Just [PoolName "PoolB"])) 3000)
+      (inspects!!2)
+     ,testCase "pool current balance (run time)" $
+     assertEqual "pool current balance (run time)"
+      (InspectBal (toDate "20220101") (FutureCurrentPoolBalance (Just [PoolName "PoolB",PoolName "PoolA"])) 4000)
+      (inspects!!3)
+   ]
diff --git a/test/DealTest/ResecDealTest.hs b/test/DealTest/ResecDealTest.hs
new file mode 100644
--- /dev/null
+++ b/test/DealTest/ResecDealTest.hs
@@ -0,0 +1,131 @@
+module DealTest.ResecDealTest(baseCase)
+
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Deal
+
+import qualified Accounts as A
+import qualified Stmt as S
+import qualified Pool as P
+import qualified Asset as Ast 
+import qualified AssetClass.Mortgage as ACM
+import qualified AssetClass.AssetBase as AB
+import qualified Expense as F
+import qualified Deal.DealBase as D
+import qualified Deal as DR
+import qualified Liability as L
+import qualified Waterfall as W
+import qualified Cashflow as CF
+import qualified Assumptions as AP
+import qualified Call as C
+import InterestRate
+import qualified CreditEnhancement as CE
+import qualified Triggers as Trg
+import Lib
+import Types
+
+import qualified Data.Map as Map
+import qualified Data.Time as T
+import qualified Data.Set as S
+import Numeric.Lens (base)
+import qualified Types as P
+
+dummySt = (0,Lib.toDate "19000101",Nothing)
+
+baseCase = D.TestDeal {
+  D.name = "base case"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = (Map.fromList
+  [("General", (A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing }))])
+  ,D.fees = Map.empty
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndDuePrin=0.0
+                             ,L.bndDueInt=0.0
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndStmt=Nothing})
+                         ]
+           )
+  ,D.pool = D.MultiPool (Map.fromList [(PoolConsol, (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}
+                                         4000
+                                         0.085
+                                         60
+                                         Nothing
+                                         AB.Current]
+                               ,P.futureCf=Nothing
+                               ,P.asOfDate = T.fromGregorian 2022 1 1
+                               ,P.issuanceStat = Nothing
+                               ,P.extendPeriods = Nothing}))])
+   ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                 (W.PayInt Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["A"] Nothing)
+   ])]
+ ,D.collects = [W.Collect Nothing W.CollectedInterest "General"
+             ,W.Collect Nothing W.CollectedPrincipal "General"]
+}
+
+resecDeal = D.TestDeal {
+  D.name = "Top Deal"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = (Map.fromList
+  [("General", (A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing }))])
+  ,D.fees = Map.empty
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndDuePrin=0.0
+                             ,L.bndDueInt=0.0
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndStmt=Nothing})
+                         ]
+           )
+  ,D.pool = D.ResecDeal (Map.fromList [(DealBondFlow "base case" "A" (toDate "20200101") 0.25
+                                        , 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)
+   ])]
+ ,D.collects = [W.Collect Nothing W.CollectedInterest "General"
+             ,W.Collect Nothing W.CollectedPrincipal "General"]
+}
diff --git a/test/DealTest/RevolvingTest.hs b/test/DealTest/RevolvingTest.hs
new file mode 100644
--- /dev/null
+++ b/test/DealTest/RevolvingTest.hs
@@ -0,0 +1,136 @@
+module DealTest.RevolvingTest(baseTests)
+
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Deal
+
+import qualified Accounts as A
+import qualified Stmt as S
+import qualified Pool as P
+import qualified AssetClass.Mortgage as ACM
+import qualified AssetClass.AssetBase as AB
+import qualified Expense as F
+import qualified Deal.DealBase as D
+import qualified Deal as DR
+import qualified Liability as L
+import qualified Waterfall as W
+import qualified Revolving as R
+import qualified Cashflow as CF
+import qualified Assumptions as AP
+import qualified Call as C
+import InterestRate
+import qualified CreditEnhancement as CE
+import qualified Triggers as Trg
+import Lib
+
+import qualified Data.Map as Map
+import qualified Data.Time as T
+import qualified Data.Set as S
+import Types
+
+import Control.Lens hiding (element)
+import Control.Lens.TH
+
+multiPool = Map.fromList [(PoolName "PoolA",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}
+                                                                   1000 0.085 60 Nothing AB.Current]
+                                                      ,P.futureCf= Nothing
+                                                      ,P.asOfDate = T.fromGregorian 2022 1 1
+                                                      ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,1000)]
+                                                      ,P.extendPeriods = Nothing
+                                                      })
+                         ,(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= Nothing
+                                                        ,P.asOfDate = T.fromGregorian 2022 1 1
+                                                        ,P.issuanceStat = Just $ Map.fromList [(IssuanceBalance,3000)]
+                                                        ,P.extendPeriods = Nothing}))]
+
+
+baseCase = D.TestDeal {
+  D.name = "base case"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = (Map.fromList
+  [("General", (A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing }))])
+  ,D.fees = Map.empty
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndDuePrin=0.0
+                             ,L.bndDueInt=0.0
+                             ,L.bndStepUp = Nothing
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndDueIntOverInt = 0
+                             ,L.bndStmt=Nothing})
+                         ]
+           )
+  ,D.pool = D.MultiPool multiPool 
+   ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                 (W.PayInt Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["A"] Nothing)
+   ])]
+ ,D.collects = [W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedInterest "General"
+               ,W.Collect (Just [PoolName "PoolA",PoolName "PoolB"]) W.CollectedPrincipal "General"
+             ]
+ ,D.liqProvider = Nothing
+ ,D.rateCap = Nothing
+ ,D.triggers = Nothing
+ ,D.ledgers = Nothing
+ ,D.stats = (Map.empty,Map.empty,Map.empty,Map.empty)
+}
+
+
+baseTests = 
+  let 
+    poolAssets = [(AB.PersonalLoan AB.LoanOriginalInfo{AB.originBalance= 1000, AB.originRate= Fix DC_ACT_365F 0.08,
+                                                    AB.originTerm = 24, AB.period = Monthly ,AB.startDate = (T.fromGregorian 2022 1 1),
+                                                    AB.prinType = AB.I_P}
+                                1000
+                                0.08
+                                24
+                                AB.Current)]
+    rAssump = Just (AP.AvailableAssets (R.ConstantAsset $ AB.LO <$> poolAssets)
+                                                (AP.PoolLevel ((AP.LoanAssump Nothing Nothing Nothing Nothing)
+                                                                ,AP.DummyDelinqAssump
+                                                                ,AP.DummyDefaultAssump))
+                            )
+    inspectVars = [AP.InspectRpt MonthEnd [FutureCurrentPoolBalance Nothing
+                                          ,FutureCurrentPoolBalance (Just [PoolName "PoolA"])
+                                          ,FutureCurrentPoolBalance (Just [PoolName "PoolB"])
+                                          ,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 S.empty Nothing nonRunAssump of
+                                    Right x -> x
+                                    Left y -> error ("Error in running deal"++ show y)
+  in 
+   testGroup "Revolving: Single Pool" 
+   [ testCase "Asset: Loan" $
+     assertEqual  "First Pay"
+     True
+     True
+     ,testCase "empty pool flow" $
+     assertEqual "empty pool flow"
+     0
+     -- (P.futureCf (D.pool baseCase))
+     0
+   ]
+
diff --git a/test/MainTest.hs b/test/MainTest.hs
new file mode 100644
--- /dev/null
+++ b/test/MainTest.hs
@@ -0,0 +1,116 @@
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import Data.List
+import Data.Ord
+
+import qualified UT.AssetTest as AT
+import qualified UT.AccountTest as AccT
+import qualified UT.CashflowTest as CFT
+import qualified UT.BondTest as BT
+import qualified UT.LibTest as LT
+import qualified UT.ExpTest as ET
+import qualified UT.DealTest as DT
+import qualified UT.DealTest2 as DT2
+import qualified UT.QueryTest as QT
+import qualified UT.StmtTest as ST
+import qualified UT.UtilTest as UtilT
+import qualified UT.AnalyticsTest as AnalyticsT
+import qualified UT.InterestRateTest as IRT
+import qualified UT.RateHedgeTest as RHT
+import qualified UT.CeTest as CET
+
+
+import qualified DealTest.DealTest as DealTest
+import qualified DealTest.RevolvingTest as RevolvingTest
+import qualified DealTest.MultiPoolDealTest as DealMultiTest
+
+import qualified Accounts as A
+import qualified Lib as L
+import qualified Stmt as S
+import qualified Data.Time as T
+import qualified Data.Vector as UtilT
+import qualified UT.UtilTest as RH
+import GHC.Generics (U1(U1))
+
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests" [AT.mortgageTests
+                           ,AT.mortgageCalcTests
+                           ,AT.btlMortgageTest
+                           ,AT.loanTests
+                           ,AT.leaseTests
+                           ,AT.installmentTest
+                           ,AT.armTest
+                           ,AT.ppyTest
+                           ,AT.delinqScheduleCFTest
+                           ,AT.delinqMortgageTest
+                           ,AT.nonPayMortgageTest
+                           ,AT.receivableTest
+                           ,AT.fixedAssetTest
+                           ,CFT.cfTests
+                           ,CFT.tsSplitTests
+                           ,CFT.testMergePoolCf
+                           ,CFT.combineTest
+                           ,CFT.testHaircut
+                           ,CFT.testMergeTsRowsFromTwoEntities
+                           ,CFT.testCumStat
+                           ,CFT.testClawIntTest
+                           ,CFT.testPoolAggTest
+                           ,BT.pricingTests
+                           ,BT.bndConsolTest
+                           ,BT.writeOffTest
+                           ,LT.curveTests
+                           ,LT.periodCurveTest
+                           ,LT.pvTests
+                           ,LT.seqFunTest
+                           -- --,LT.queryStmtTests
+                           ,LT.datesTests
+                           ,LT.prorataTests
+                           ,LT.tsOperationTests
+                           ,ET.expTests
+                           ,DT.queryTests
+                           ,DT.triggerTests
+                           ,DT.dateTests
+                           ,DT.liqProviderTest
+                           ,DT.poolFlowTest
+                           ,DT2.queryTests
+                           ,UtilT.daycountTests1
+                           ,UtilT.daycountTests2
+                           ,UtilT.daycountTests3
+                           ,UtilT.daycountTests4
+                           ,UtilT.tsTest
+                           ,UtilT.ts2Test
+                           ,UtilT.ts3Test
+                           ,UtilT.dateVectorPatternTest
+                           ,UtilT.paddingTest
+                           ,UtilT.dateSliceTest
+                           ,UtilT.capTest
+                           ,UtilT.roundingTest
+                           ,UtilT.sliceTest
+                           ,UtilT.splitTsTest
+                           ,UtilT.tableTest
+                           ,UtilT.lastOftest
+                           ,UtilT.paySeqTest
+                           ,UtilT.scaleListTest
+                           ,AccT.intTests
+                           ,AccT.investTests
+                           ,AccT.reserveAccTest
+                           ,QT.queryTest
+                           ,ST.txnTest
+                           -- ,ST.txnCalcTest
+                           ,IRT.armResetTests
+                           ,IRT.interestRoundingTest
+                           ,AnalyticsT.walTest
+                           ,AnalyticsT.durationTest
+                           ,AnalyticsT.fvTest
+                           ,AnalyticsT.assetPricingTest
+                           ,AnalyticsT.irrTest
+                           ,AnalyticsT.survivorTest
+                           ,DealTest.baseTests
+                           ,RevolvingTest.baseTests
+                           ,DealMultiTest.mPoolbaseTests
+                           ,RHT.capRateTests
+                           ,CET.liqTest
+                           ]
diff --git a/test/UT/AccountTest.hs b/test/UT/AccountTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/AccountTest.hs
@@ -0,0 +1,112 @@
+module UT.AccountTest(intTests,reserveAccTest,investTests)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Accounts 
+import Lib
+import Stmt
+import Util
+import DateUtil
+import Types
+import Deal
+import Deal.DealQuery (queryCompound)
+import Deal.DealBase
+import qualified Cashflow as CF
+
+import qualified Pool as P
+import Control.Lens hiding (element,Empty)
+import Control.Lens.TH
+import Data.Map.Lens
+
+
+import qualified Data.Time as T
+import qualified Data.DList as DL 
+import qualified Data.Map as Map
+import UT.DealTest (td2)
+
+dummySt = (0,Lib.toDate "19000101",Nothing)
+
+
+intTests =
+  let 
+    acc1 = Account 200 "A1" (Just (BankAccount 0.03 QuarterEnd (toDate "20221001"))) Nothing Nothing
+    acc2 = Account 150 "A1" (Just (BankAccount 0.03 MonthEnd (toDate "20220301"))) Nothing 
+          (Just (Statement (DL.fromList [ AccTxn (toDate "20220715") 120 10 Empty
+                          ,AccTxn (toDate "20220915") 150 30 Empty ])))
+  in 
+    testGroup "Interest on Bank Account Test"
+     [
+      testCase "Build EarnIntAction" $
+        assertEqual "QuarterEnd" 
+          [("A1",(genSerialDates QuarterEnd Inc (toDate "20221001") 5))] $ 
+          buildEarnIntAction [acc1] (toDate "20231231") []
+      ,testCase "Build EarnIntAction Same Year" $
+        assertEqual "QuarterEnd Same Year" 
+          [("A1",(genSerialDates QuarterEnd Inc (toDate "20221001") 1))] $ 
+          buildEarnIntAction [acc1] (toDate "20221231") []
+      ,testCase "Validate Interest Calculation 1" $
+        assertEqual "MonthEnd with No txn"
+        200.5
+        (accBalance (depositInt (toDate "20221101") acc1 ))
+      ,testCase "Validate Interest Calculation 2" $
+        assertEqual "MonthEnd with txns"
+        152.40
+        (accBalance (depositInt (toDate "20221101") acc2 ))
+     ]
+
+investTests =
+  let 
+    rc = mkTs [(toDate "20211201",0.03),(toDate "20221201",0.03)]
+    acc1 = Account 2000 "A1" (Just (InvestmentAccount SOFR1Y 0.015 QuarterEnd QuarterEnd (toDate "20221001") 0.04)) Nothing Nothing
+    acc2 = Account 150 "A1" (Just (InvestmentAccount SOFR1Y 0.01 QuarterEnd QuarterEnd (toDate "20220301") 0.03)) Nothing 
+          (Just (Statement (DL.fromList [ AccTxn (toDate "20220715") 120 10 Empty
+                            ,AccTxn (toDate "20220915") 150 30 Empty ])))
+  in 
+    testGroup "Interest on Invest Account Test"
+     [
+      testCase "Validate Interest Calculation 1" $
+        assertEqual "MonthEnd with No txn"
+        2006.66
+        (accBalance (depositInt (toDate "20221101") acc1))
+      ,testCase "Validate Interest Calculation 2" $
+        assertEqual "MonthEnd with txns"
+        152.40
+        (accBalance (depositInt (toDate "20221101") acc2 ))
+     ]
+
+
+reserveAccTest = 
+  let 
+    acc1 = Account 200 "A1" Nothing (Just (PctReserve (CurrentPoolBalance Nothing) 0.01)) Nothing
+    acc2 = Account 150 "A2" Nothing (Just (FixReserve 210)) Nothing
+    accMap = Map.fromList [("A1",acc1),("A2",acc2)]
+    testCFs = CF.CashFlowFrame dummySt
+               [CF.MortgageFlow (toDate "20220601") 150 20 10 0 0 0 0 0 Nothing Nothing Nothing
+               ,CF.MortgageFlow (toDate "20220701") 130 20 10 0 0 0 0 0 Nothing Nothing Nothing
+               ,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, Nothing)) td2 {accounts = accMap}
+  in 
+    testGroup "Test On Reserve Acc"
+     [
+      testCase "Test on Pct Reserve" $
+        assertEqual "shall be " 
+          (Right 0.7)
+          (calcTargetAmount ttd (toDate "20220826") acc1)
+     ,testCase "Test on fix Reserve" $
+        assertEqual "shall be " 
+          (Right 210)
+          (calcTargetAmount ttd (toDate "20220801") acc2)
+     ,testCase "test on reserve account gap" $
+        assertEqual "pct reserve gap "
+          (Right 0)
+          (queryCompound ttd (toDate "20220826") (ReserveGapAt (toDate "20220826") ["A1"]))
+     ,testCase "test on reserve account gap" $
+        assertEqual "fix reserve gap "
+          (Right 60)
+          (queryCompound ttd (toDate "20220801") (ReserveGapAt (toDate "20220801") ["A2"]))
+     ]
+
+
diff --git a/test/UT/AnalyticsTest.hs b/test/UT/AnalyticsTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/AnalyticsTest.hs
@@ -0,0 +1,137 @@
+module UT.AnalyticsTest(walTest,durationTest,fvTest,assetPricingTest,irrTest,survivorTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import qualified Lib as L
+import Analytics 
+import Assumptions
+import Types
+import Asset (priceAsset)
+import AssetClass.AssetBase
+import AssetClass.Loan
+import InterestRate
+
+import Data.Ratio
+
+walTest = 
+  let 
+    _ps = [(50,L.toDate "20230630"),(50,L.toDate "20231231")]
+  in 
+    testGroup "Calc WAL"
+    [ 
+      testCase "WAL by Month" $ 
+        assertEqual ""
+          9.06
+          (calcWAL ByMonth 100 (L.toDate "20230101") _ps )
+      ,testCase "WAL by Year" $ 
+        assertEqual ""
+          0.74
+          (calcWAL ByYear 100 (L.toDate "20230101") _ps )
+    ]
+
+durationTest = 
+  testGroup "Duration Test" 
+  [
+    testCase "Duration 1" $ 
+      assertEqual "10 Months bullet"
+      (273 % 365)
+      (calcDuration 
+        DC_ACT_365F
+        (L.toDate "20230101")
+        [(L.toDate "20231001",100)]
+        (L.mkRateTs [(L.toDate "20230101",0.01)]))
+  , testCase "Duration 2" $ 
+      assertEqual "Multiple cf"
+      (252921 % 289445)
+      (calcDuration 
+        DC_ACT_365F
+        (L.toDate "20230101")
+        [(L.toDate "20231001",100),(L.toDate "20240101",100)]
+        (L.mkRateTs [(L.toDate "20230101",0.01)]))
+  , testCase "Duration 3" $
+      assertEqual "12 Months bullet"
+      (364 % 365)
+      (calcDuration
+        DC_ACT_365F
+        (L.toDate "20230101")
+        [(L.toDate "20231231",104)]
+        (L.mkRateTs [(L.toDate "20230101",0.05)]))
+  , testCase "Convexity 1" $
+      assertEqual "10 Months bullet"
+      (4068161010949933 % 2251799813685248)
+      (calcConvexity
+        DC_ACT_365F
+        (L.toDate "20230101")
+        [(L.toDate "20231231",104)]
+        (L.mkRateTs [(L.toDate "20230101",0.05)]))
+  ]
+
+fvTest = 
+  testGroup "FV Test" [
+    testCase "FV2 test" $ 
+        assertEqual "1-year"
+            108
+            (fv2 0.08 (L.toDate "20230101") (L.toDate "20240101") 100) 
+    ,testCase "FV2 test" $ 
+        assertEqual "0.5-year"
+            103.89
+            (fv2 0.08 (L.toDate "20230101") (L.toDate "20230701") 100) 
+  ]
+
+assetPricingTest = 
+  testGroup "Pricing on Asset" [
+    testCase "Loan Pricing(Inc Int)" $
+      assertEqual "Loan Pricing"
+        (Right (AssetPrice 1037.38 0.76 0.726208 0.0005369 0.21))
+        (priceAsset (PersonalLoan (LoanOriginalInfo 1200 (Fix DC_30_360_US 0.08) 12 Monthly (L.toDate "20240701") I_P Nothing) 1000 0.08 10 Current)
+                    (L.toDate "20241002") 
+                    (PvRate 0.03) 
+                    (LoanAssump Nothing Nothing Nothing Nothing,DummyDelinqAssump,DummyDefaultAssump)
+                    Nothing 
+                    Inc)
+    ,testCase "Loan Pricing(Exc Int)" $
+      assertEqual "Loan Pricing"
+        (Right (AssetPrice 1037.17 0.76  0.72633840 0.00052012  0.21))
+        (priceAsset (PersonalLoan (LoanOriginalInfo 1200 (Fix DC_30_360_US 0.08) 12 Monthly (L.toDate "20240701") I_P Nothing) 1000 0.08 10 Current)
+                    (L.toDate "20241002") 
+                    (PvRate 0.03) 
+                    (LoanAssump Nothing Nothing Nothing Nothing,DummyDelinqAssump,DummyDefaultAssump)
+                    Nothing 
+                    Exc)
+  ]
+
+irrTest = 
+  testGroup "Irr Test" [
+    testCase "required Amount with 8%" $ 
+        assertEqual "12 months"
+            (Just 108.0)
+            (calcRequiredAmtForIrrAtDate 0.08 (L.toDates ["20230101"])
+                                                [-100] 
+                                                (L.toDate "20240101"))
+    ,testCase "IRR with 8%" $ 
+        assertEqual "12 months"
+            (Right (360287970912109 % 4503599627370496))
+            (calcIRR (L.toDates ["20230101","20240101"]) [-100,108])
+    ,testCase "IRR with custom" $ 
+        assertEqual "3 months"
+            (Right (7681459818792919 % 18014398509481984))
+            (calcIRR (L.toDates ["20250101","20250301","20251018"]) [-100,50,70])
+  ]
+    -- ,testCase "FV2 test" $ 
+    --     assertEqual "0.5-year"
+    --         103.89
+    --         (fv2 0.08 (L.toDate "20230101") (L.toDate "20230701") 100) 
+survivorTest = 
+  testGroup "Survivor Test" [
+    testCase "Survivor 1" $ 
+        assertEqual "12 months"
+            [0.9]
+            (calcSurvivorFactors (L.toDate "20230101") [(L.toDate "20240101")] 0.1)
+    ,testCase "Survivor 2" $ 
+        assertEqual "3 months"
+            [0.9743552534572951,0.9]
+            (calcSurvivorFactors (L.toDate "20230101") [(L.toDate "20230401"),(L.toDate "20240101")] 0.1)
+  ]
diff --git a/test/UT/AssetTest.hs b/test/UT/AssetTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/AssetTest.hs
@@ -0,0 +1,944 @@
+module UT.AssetTest(mortgageTests,mortgageCalcTests,loanTests,leaseTests,installmentTest,armTest,ppyTest
+                   ,delinqScheduleCFTest,delinqMortgageTest,btlMortgageTest,nonPayMortgageTest,receivableTest,fixedAssetTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import qualified Lib as L
+import qualified Asset as Ast
+import qualified Pool as P
+import qualified AssetClass.AssetBase as AB
+import qualified AssetClass.Mortgage as ACM
+import qualified AssetClass.Loan as ACL
+import qualified AssetClass.Lease as ACR
+import qualified AssetClass.Installment as ACI
+import qualified AssetClass.Receivable as AR
+import qualified Assumptions as A
+import qualified Cashflow as CF
+import qualified Deal as D
+import Types
+import Data.Either
+import InterestRate
+
+import Debug.Trace
+import Control.Lens hiding (element)
+import Control.Lens.TH
+debug = flip trace
+
+dummySt = (0,L.toDate "19000101",Nothing)
+
+tm = AB.Mortgage
+     (AB.MortgageOriginalInfo 10000 (Fix DC_ACT_365F 0.08) 24 L.Monthly (L.toDate "20210101") AB.Level Nothing Nothing)
+     8000 0.08 19 
+     Nothing
+     AB.Current
+
+tm1 = AB.Mortgage
+     (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 24 L.Monthly (L.toDate "20210101") AB.Even Nothing Nothing)
+     240 0.08 19 
+     Nothing
+     AB.Current
+
+tm2 = AB.Mortgage
+     (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 24 L.Monthly (L.toDate "20210101") AB.Even Nothing Nothing)
+     240 0.08 19 
+     Nothing 
+     (AB.Defaulted Nothing)
+
+tm4 = AB.Mortgage
+        (AB.MortgageOriginalInfo 240 (Fix DC_30_360_US 0.08) 36 L.Monthly (L.toDate "20210701") (AB.Balloon 120) Nothing Nothing)
+        120 0.08 36
+        Nothing 
+        AB.Current
+
+tm5 = AB.Mortgage
+        (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 36 L.Monthly (L.toDate "20210101") (AB.Balloon 120)  Nothing Nothing)
+        100 0.08 24 
+        Nothing 
+        AB.Current
+
+
+tm6 = AB.Mortgage
+        (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 36 L.Monthly (L.toDate "20210101") (AB.Balloon 120) Nothing Nothing)
+        120 0.08 36
+        Nothing 
+        AB.Current
+
+tm7 = AB.Mortgage
+        (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 36 L.Monthly (L.toDate "20210101") (AB.Balloon 120)  Nothing Nothing)
+        120 0.08 24
+        Nothing 
+        AB.Current
+
+
+
+asOfDate = L.toDate "20210605"
+
+(tmcf_00,_) = case Ast.projCashflow tm asOfDate (A.MortgageAssump Nothing Nothing Nothing Nothing,A.DummyDelinqAssump,A.DummyDefaultAssump) Nothing of
+                Left _ -> undefined
+                Right x -> x
+trs = tmcf_00^.CF.cashflowTxn  
+(tmcf_default,_) = case Ast.projCashflow tm asOfDate (A.MortgageAssump (Just (A.DefaultConstant 0.015)) Nothing Nothing Nothing ,A.DummyDelinqAssump,A.DummyDefaultAssump) Nothing of
+                     Left _ -> undefined
+                     Right x -> x
+
+
+mortgageCalcTests = testGroup "Mortgage Calc Test" 
+  [
+    testCase "Calc Pmt 1" $
+        assertEqual "PMT 01"
+           154.15 (AB.calcPmt 1200 0.12 24),
+    testCase "Calc Pmt 2" $
+        assertEqual "PMT 02"
+           100.0 (AB.calcPmt 1200 0.0 12)
+  ]
+
+
+mortgageTests = testGroup "Mortgage cashflow Tests"
+  [
+    testCase "Fix rate mortgage" $
+     --  19 @=? (CF.sizeCashFlowFrame tmcf_00)
+     assertEqual "total size of cf" 19 (CF.sizeCashFlowFrame tmcf_00) -- `debug` ("result"++show(tmcf_00))
+     ,
+     testCase "first Date" $
+     assertEqual "first date" (L.toDate "20210701")  (CF.getDate (head trs)) -- `debug` ("result"++show(tmcf_00))
+     --assertEqual "total size of cf" 19 19
+     ,
+     testCase "Even Principal Type of Mortgage" $
+     let
+        tm1cf_00 = case Ast.calcCashflow tm1 asOfDate Nothing of
+                         Left _ -> undefined
+                         Right x -> x
+        trs = tm1cf_00 ^. CF.cashflowTxn  
+     in
+        assertEqual "first row" 12.63  (CF.mflowPrincipal (head trs)) -- `debug` ("result"++show(tmcf_00))
+     ,
+     testCase "Default asset won't have cashflow if no assumption" $
+     let
+        asDay = L.toDate "20220101"
+        (tm2cf_00, _) = case Ast.projCashflow tm2 asDay (A.MortgageAssump Nothing Nothing Nothing Nothing ,A.DummyDelinqAssump,A.DummyDefaultAssump) Nothing of
+                         Left _ -> undefined
+                         Right x -> x
+        trs = tm2cf_00 ^. CF.cashflowTxn  
+     in
+        assertEqual "Empty for principal"
+                    (0.0, asDay, 1)
+                    (CF.mflowPrincipal (head trs)
+                    ,(view CF.tsDate (head trs))
+                    ,length trs)
+     ,
+     testCase "Balloon Mortgage test 1" $
+     let
+        tm1cf_00 = case Ast.calcCashflow tm4 asOfDate Nothing of-- `debug` (">>>")
+                         Left _ -> undefined
+                         Right x -> x
+        trs = tm1cf_00 ^. CF.cashflowTxn  
+     in
+        assertEqual "first & last row row" 
+                    [94.29,0.62,0.66, 0.79] 
+                    [CF.mflowPrincipal (last trs)
+                    ,CF.mflowInterest (last trs)
+                    ,(CF.mflowPrincipal . head . tail) trs
+                    ,(CF.mflowInterest . head . tail) trs ] -- `debug` ("trs for balloon"++show tm1cf_00)
+     ,
+     testCase "Balloon Mortgage test 2" $
+     let
+        tm1cf_00 = case Ast.calcCashflow tm5 asOfDate Nothing of
+                         Left _ -> undefined
+                         Right x -> x
+        trs = tm1cf_00 ^. CF.cashflowTxn 
+     in
+        assertEqual "first & last row row" 
+                    [84.19,0.56,0.64, 0.66] 
+                    [CF.mflowPrincipal (last trs)
+                    ,CF.mflowInterest (last trs)
+                    ,(CF.mflowPrincipal . head . tail) trs
+                    ,(CF.mflowInterest . head . tail) trs ] -- `debug` ("trs for balloon"++show tm1cf_00)
+     ,testCase "Balloon Mortgage test 3" $
+     let
+        (tm1cf_00,_) = case Ast.projCashflow tm6 (L.toDate "20201205")
+                         (A.MortgageAssump Nothing (Just (A.PrepaymentCPR 0.1)) Nothing Nothing ,A.DummyDelinqAssump,A.DummyDefaultAssump) Nothing of 
+                         Left _ -> undefined
+                         Right x -> x
+        trs = tm1cf_00 ^. CF.cashflowTxn 
+     in
+        assertEqual "first & last row row" 
+                    [68.77, 0.45, 1.06, 0.65, 0.79] 
+                    [CF.mflowPrincipal (last trs)
+                    ,CF.mflowInterest (last trs)
+                    ,(CF.mflowPrepayment) (trs!!1)
+                    ,(CF.mflowPrincipal) (trs!!1)
+                    ,(CF.mflowInterest) (trs!!1) ] -- `debug` ("trs for balloon"++show tm1cf_00)
+    ,testCase "Balloon Mortgage test 4" $
+     let
+        (tm1cf_00,_) = case Ast.projCashflow tm7 (L.toDate "20201205")
+                         (A.MortgageAssump Nothing (Just (A.PrepaymentCPR 0.1)) Nothing Nothing ,A.DummyDelinqAssump,A.DummyDefaultAssump) Nothing of
+                         Left _ -> undefined
+                         Right x -> x
+        trs = tm1cf_00 ^. CF.cashflowTxn
+     in
+        assertEqual "first & last row row" 
+                    ([82, 0.73, 0.54, 1.06, 0.75, 0.79], 25) 
+                    ([CF.mflowPrincipal (last trs)
+                    ,CF.mflowPrepayment (last trs)
+                    ,CF.mflowInterest (last trs)
+                    ,(CF.mflowPrepayment) (trs!!1)
+                    ,(CF.mflowPrincipal) (trs!!1)
+                    ,(CF.mflowInterest) (trs!!1) 
+                    ], CF.sizeCashFlowFrame tm1cf_00) -- `debug` ("trs for balloon"++show tm1cf_00)
+    ,testCase "Balloon Mortgage test 5" $
+     let
+        (tm1cf_00,_) = case Ast.projCashflow tm7 (L.toDate "20201205")
+                         (A.MortgageAssump (Just (A.DefaultAtEndByRate 0.05 0.1)) Nothing Nothing Nothing ,A.DummyDelinqAssump,A.DummyDefaultAssump) Nothing of
+                         Left _ -> undefined
+                         Right x -> x
+        trs = tm1cf_00 ^. CF.cashflowTxn 
+     in
+        assertEqual "first & last row row" 
+                    ([74.34, 17.43, 0.49, 0.52, 0.76, 0.79], 25) 
+                    ([CF.mflowPrincipal (last trs)
+                    ,CF.mflowDefault (last trs)
+                    ,CF.mflowInterest (last trs)
+                    ,(CF.mflowDefault) (trs!!1)
+                    ,(CF.mflowPrincipal) (trs!!1)
+                    ,(CF.mflowInterest) (trs!!1) 
+                    ], CF.sizeCashFlowFrame tm1cf_00) -- `debug` ("trs for balloon"++show tm1cf_00)        
+  ]
+
+loanTests = 
+    let 
+      loan1 =  AB.PersonalLoan
+                 (AB.LoanOriginalInfo 180 (Fix DC_ACT_365F 0.08) 36 L.Monthly (L.toDate "20200101") AB.I_P Nothing) 
+                 120
+                 0.08
+                 24
+                 AB.Current
+      asofDate = L.toDate "20200615"
+      loan1Cf = case Ast.calcCashflow loan1 asofDate Nothing of
+                  Left _ -> undefined
+                  Right x -> x
+      (loan2Cf,_) = case Ast.projCashflow loan1 asofDate (A.LoanAssump Nothing Nothing Nothing Nothing ,A.DummyDelinqAssump,A.DummyDefaultAssump) Nothing of 
+                  Left _ -> undefined
+                  Right x -> x
+
+    in 
+      testGroup "Loan cashflow Tests" [ 
+       testCase "Loan 1" $
+           assertEqual "project period"
+             25
+             (CF.sizeCashFlowFrame loan1Cf)
+      -- ,testCase "First cashflow" $
+      --     assertEqual ""
+      --      (Just (CF.LoanFlow (L.toDate "20210201") 120 0 0.82 0 0 0 0 0.08))
+      --      (CF.cfAt loan1Cf 0)
+      -- ,testCase "Last Principal Amount" $
+      --     assertEqual ""
+      --      (Just (CF.LoanFlow (L.toDate "20230101") 0 120 0.82 0 0 0 0 0.08))
+      --      (CF.cfAt loan1Cf 23)
+      -- ,testCase "calcCashflow == projCashflow when assump = []" $
+      --     assertEqual ""
+      --     loan1Cf
+      --     loan2Cf
+     ]
+
+leaseTests = 
+    let 
+      lease1 = AB.RegularLease
+                (AB.LeaseInfo (L.toDate "20230101") 12 (AB.ByDayRate 1 MonthEnd) Nothing)
+                100
+                12
+                AB.Current
+      asofDate = L.toDate "20230615"
+      cf1 = case Ast.calcCashflow lease1 asofDate Nothing of 
+              Left _ -> undefined
+              Right x -> x
+ 
+      lease2 = AB.StepUpLease
+                (AB.LeaseInfo (L.toDate "20230601") 12 (AB.ByDayRate 1 MonthEnd) Nothing)
+                (AB.FlatRate 1.02)
+                100
+                12
+                AB.Current
+      cf2 = case Ast.calcCashflow lease2 asofDate Nothing of -- 2020 06 15
+              Left _ -> undefined
+              Right x -> x
+      
+      lease3 = AB.StepUpLease
+                (AB.LeaseInfo (L.toDate "20230401") 4 (AB.ByDayRate 1 MonthEnd) Nothing)
+                (AB.ByRateCurve [1.04,1.05,1.06])
+                100
+                4
+                AB.Current
+      cf3_0 = case Ast.calcCashflow lease3 (L.toDate "20230415") Nothing of
+              Left _ -> undefined
+              Right x -> x
+      cf3 = case Ast.calcCashflow lease3 asofDate Nothing of
+              Left _ -> undefined
+              Right x -> x
+      (cf4,_) = case Ast.projCashflow lease1 asofDate 
+                  (A.LeaseAssump Nothing
+                                 (A.GapDays 45)
+                                 (A.BaseAnnualRate 0.0)
+                                 (A.CutByDate (L.toDate "20240601"))
+                                 
+                   ,A.DummyDelinqAssump,A.DummyDefaultAssump)
+                   Nothing of 
+                  Left _ -> undefined
+                  Right x -> x
+      -- (cf5,_) =  case Ast.projCashflow lease1 asofDate 
+      --              (A.LeaseAssump Nothing
+      --                             (A.GapDaysByAmount [(0.5,12),(1,22),(2,62),(3,82)] 92)
+      --                             (A.BaseAnnualRate 0.0)
+      --                             (A.CutByDate (L.toDate "20240601"))
+      --                             
+      --              ,A.DummyDelinqAssump,A.DummyDefaultAssump)
+      --              Nothing of
+      --             Left _ -> undefined
+      --             Right x -> x
+    in 
+      testGroup "Lease CF Test" [
+        testCase "1 year Regular Lease sum of rentals/dates" $
+            assertEqual "Dates"
+                (L.toDates ["20230131","20230228","20230331","20230430","20230531","20230630"
+                            ,"20230731","20230831","20230930","20231031","20231130","20231231"])
+                (Ast.getPaymentDates lease1 0)
+        ,testCase "1 year Regular Lease sum of rentals/dates" $
+            assertEqual "cf dates"
+                (L.toDates ["20230630","20230731","20230831","20230930","20231031","20231130","20231231"])
+                (CF.getDate <$> (cf1 ^. CF.cashflowTxn))
+        ,testCase "1 year Regular Lease sum of rentals/first" $
+            assertEqual "First flow"
+                (CF.LeaseFlow (L.toDate "20230630") 184.00 30.0 0.0)
+                (head (cf1 ^. CF.cashflowTxn))
+        ,testCase "1 year Regular Lease sum of rentals/last" $
+            assertEqual "Last flow"
+                (CF.LeaseFlow (L.toDate "20231231") 0.00 31.0 0.0)
+                (last (cf1 ^. CF.cashflowTxn))
+        ,testCase "1 year Regular Lease sum of rentals" $
+            assertEqual "total rental"
+                214
+                (sum $ map CF.tsTotalCash (cf1 ^. CF.cashflowTxn))
+        ,testCase "1 year Regular Lease first pay date" $
+            assertEqual "first date of regular lease"
+                (L.toDate "20230630")
+                (head (CF.getDatesCashFlowFrame cf1))
+        ,testCase "1 year Stepup lease first pay" $
+            assertEqual "first pay"
+                (CF.LeaseFlow (L.toDate "20230630") 376.24 29 0.0)
+                (head (cf2 ^. CF.cashflowTxn))
+        ,testCase "1 year Stepup lease" $
+            assertEqual "total rental"
+                405.24
+                (sum $ map CF.tsTotalCash (cf2 ^. CF.cashflowTxn))
+        ,testCase "1 year Stepup lease" $
+            assertEqual "first rental step up at Month 2"
+                (CF.LeaseFlow (L.toDate "20230731") 344.62 31.62 0.0)
+                ((cf2 ^. CF.cashflowTxn)!!1)
+        ,testCase "1 year Stepup Curve lease" $
+            assertEqual "first rental step up at Month 0"
+                (CF.LeaseFlow (L.toDate "20230430") 100.59 29.0 0.0)
+                (head (cf3_0 ^. CF.cashflowTxn )) 
+        ,testCase "1 year Stepup Curve lease" $
+            assertEqual "first rental step up at Month 1"
+                (CF.LeaseFlow (L.toDate "20230630") 35.65 32.7 0.0)
+                (head (cf3 ^. CF.cashflowTxn)) -- `debug` ("CF3->"++show cf3)
+        ,testCase "1 year Stepup Curve lease" $
+            assertEqual "first rental step up at Month 2"
+                (CF.LeaseFlow (L.toDate "20230731") 0 35.65 0.0)
+                ((cf3 ^. CF.cashflowTxn)!!1)
+        ,testCase "Lease with Assumptions" $ 
+            assertEqual "Month Gap=45 days"
+            ((CF.LeaseFlow (L.toDate "20240630") 215 30.0 0.0),(CF.LeaseFlow (L.toDate "20250131") 0 31 0))
+            (((cf4 ^. CF.cashflowTxn)!!11),(last (cf4 ^. CF.cashflowTxn))) -- `debug` ("CF4->"++show cf4)
+        -- ,testCase "Lease with Assumptions" $ 
+        --     assertEqual "Month Gap by Table : New Lease at period 0"
+        --     (CF.LeaseFlow (L.toDate "20240131") 335 8)
+        --     ((cf5 ^. CF.cashflowTxn)!!7) `debug` ("CF5->"++show cf5)
+        -- ,testCase "Lease with Assumptions" $ 
+        --     assertEqual "Month Gap by Table : New Lease at period 1"
+        --     (CF.LeaseFlow (L.toDate "20240229") 306 29)
+        --     ((cf5 ^. CF.cashflowTxn)!!8)
+      ]
+
+installmentTest = 
+    let 
+      loan1 =  AB.Installment
+                 (AB.LoanOriginalInfo 1000 (Fix DC_ACT_365F 0.01) 12 L.Monthly (L.toDate "20220101") AB.F_P Nothing)
+                 1000 
+                 12 
+                 AB.Current
+      asofDate1 = L.toDate "20220115"
+      loan1Cf = case Ast.calcCashflow loan1 asofDate1 Nothing of
+                  Left _ -> undefined
+                  Right x -> x
+
+      loan2 =  AB.Installment
+                 (AB.LoanOriginalInfo 1000 (Fix DC_ACT_365F 0.01) 12 L.Monthly (L.toDate "20220101") AB.F_P Nothing) 
+                 500 
+                 12
+                 AB.Current
+      loan2Cf = case Ast.calcCashflow loan2 asofDate1 Nothing of
+                  Left _ -> undefined
+                  Right x -> x
+
+      asofDate2 = L.toDate "20220815"
+      loan3 =  AB.Installment
+                 (AB.LoanOriginalInfo 1000 (Fix DC_ACT_365F 0.01) 12 L.Monthly (L.toDate "20220101") AB.F_P Nothing) 
+                 416.69 
+                 5
+                 AB.Current
+      loan3Cf = case Ast.calcCashflow loan3 asofDate2 Nothing of
+                  Left _ -> undefined
+                  Right x -> x
+
+      loan4 =  AB.Installment
+                 (AB.LoanOriginalInfo 1000 (Fix DC_ACT_365F 0.01) 12 L.Monthly (L.toDate "20220101") AB.F_P Nothing) 
+                 208.35 
+                 5
+                 AB.Current
+      loan4Cf = case Ast.calcCashflow loan4 asofDate2 Nothing of
+                  Left _ -> undefined
+                  Right x -> x
+      
+      loan5 =  AB.Installment
+                 (AB.LoanOriginalInfo 1200 (Fix DC_ACT_365F 0.01) 12 L.Monthly (L.toDate "20220101") (AB.PO_FirstN 4) Nothing) 
+                 1000
+                 10
+                 AB.Current
+      loan5Cf = case Ast.calcCashflow loan5 (L.toDate "20220101") Nothing of 
+                  Left _ -> undefined
+                  Right x -> x
+    in 
+      testGroup "Installment cashflow Tests" [ 
+       testCase "Loan 1" $
+           assertEqual "project period size"
+             12 
+             (CF.sizeCashFlowFrame loan1Cf)
+      ,testCase "Loan 1 (on schedule)" $
+           assertEqual "Balance/Principal/Int at period 1"
+             (Just (CF.LoanFlow (L.toDate "20220201") 916.67 83.33 10 0 0 0 0 0.01 Nothing))
+             (CF.cfAt loan1Cf 0)
+      ,testCase "Stressed Loan 1" $
+           assertEqual "Balance/Principal/Int at period 1"
+             (Just (CF.LoanFlow (L.toDate "20220201") 458.33 41.66 5 0 0 0 0 0.01 Nothing))
+             (CF.cfAt loan2Cf 0)
+      ,testCase "Loan 2 with aging(on schedule)" $
+           assertEqual "Balance/Principal/Int at period 1"
+             (Just (CF.LoanFlow (L.toDate "20220901") 333.36 83.33 10 0 0 0 0 0.01 Nothing))
+             (CF.cfAt loan3Cf 0)
+      ,testCase "Stress Loan 2 with aging" $
+           assertEqual "Balance/Principal/Int at period 1"
+             (Just (CF.LoanFlow (L.toDate "20220901") 166.68 41.66 5 0 0 0 0 0.01 Nothing))
+             (CF.cfAt loan4Cf 0)
+      ,testCase "First No Fee Loan at first period" $
+           assertEqual "Balance/Principal/Int at period 1"
+             (Just (CF.LoanFlow (L.toDate "20220301") 1000 0 0 0 0 0 0 0.01 Nothing))
+             (CF.cfAt loan5Cf 0)
+      ,testCase "First No Fee Loan at first period" $
+           assertEqual "Balance/Principal/Int at period 3"
+             (Just (CF.LoanFlow (L.toDate "20220501") 800 100 0 0 0 0 0 0.01 Nothing))
+             (CF.cfAt loan5Cf 2)
+      ,testCase "First No Fee Loan at first period" $
+           assertEqual "Balance/Principal/Int at period 4"
+             (Just (CF.LoanFlow (L.toDate "20220601") 700 100 12 0 0 0 0 0.01 Nothing))
+             (CF.cfAt loan5Cf 3) -- `debug` (show loan5Cf)
+      ]
+
+
+armTest = 
+  let 
+    arm1 = AB.AdjustRateMortgage
+            (AB.MortgageOriginalInfo 
+              240 
+              (Floater DC_ACT_365F SOFR3M 0.01 0.03 (EveryNMonth (L.toDate "20240801") 2) Nothing Nothing Nothing)
+              30
+              Monthly
+              (L.toDate "20230501")
+              AB.Level
+              Nothing
+              Nothing)
+            (ARM 12 (Just 0.015) (Just 0.01) (Just 0.09) (Just 0.02) )  
+            240 0.08 19 
+            Nothing 
+            AB.Current
+    assump1 = RateCurve 
+                SOFR3M
+                (IRateCurve [TsPoint (L.toDate "20240501") 0.05 
+                            ,TsPoint (L.toDate "20240901") 0.065
+                            ,TsPoint (L.toDate "20241215") 0.07
+                            ,TsPoint (L.toDate "20250315") 0.10
+                            ,TsPoint (L.toDate "20251001") 0.12
+                            ])
+                
+    (arm1_cf,_) = let 
+                    cf = Ast.projCashflow arm1 (L.toDate "20230601") (A.MortgageAssump Nothing Nothing Nothing Nothing
+                                                            ,A.DummyDelinqAssump,A.DummyDefaultAssump) 
+                                                            (Just [assump1])
+                  in 
+                    case cf of 
+                      Left _ -> undefined 
+                      Right x -> x
+
+  in 
+    testGroup "ARM cashflow tests" [
+      testCase "ARM case 1/ cf length" $
+        assertEqual "should be 19"
+        20
+        (CF.sizeCashFlowFrame arm1_cf)
+      ,testCase "ARM case 1/ first cash" $
+        assertEqual "first cash row"
+        (Just (CF.MortgageFlow (L.toDate "20240501") 227.66 12.34 0.6 0 0 0 0 0.03 Nothing Nothing (Just (12.34,0.00,0.00,0.00,0.00,0.00)) ))
+        (CF.cfAt arm1_cf 1)
+      ,testCase "ARM case 1/ frist reset" $
+        assertEqual "first rate"
+        (Just (CF.MortgageFlow (L.toDate "20240601") 215.41 12.25 0.85 0 0 0 0 0.045 Nothing Nothing (Just (24.59,0.00,0.00,0.00,0.00,0.00))))
+        (CF.cfAt arm1_cf 2)
+      ,testCase "ARM case 1/periodic reset " $
+        assertEqual "first rate"
+        (Just (CF.MortgageFlow (L.toDate "20240801") 190.85 12.26 0.93 0 0 0 0 0.055 Nothing Nothing (Just (49.15,0.00,0.00,0.00,0.00,0.00)) ))
+        (CF.cfAt arm1_cf 4)
+      ,testCase "ARM case 1/remains same before next reset" $
+        assertEqual "period before first reset"
+        (Just (CF.MortgageFlow (L.toDate "20240901") 178.53 12.32 0.87 0 0 0 0 0.055 Nothing Nothing (Just (61.47,0.00,0.00,0.00,0.00,0.00))))
+        (CF.cfAt arm1_cf 5)
+      ,testCase "ARM case 1" $
+        assertEqual "reset with periodic cap"
+        (Just (CF.MortgageFlow (L.toDate "20241201") 141.47 12.38 0.96 0 0 0 0 0.075 Nothing Nothing (Just (98.53,0.00,0.00,0.00,0.00,0.00))))
+        (CF.cfAt arm1_cf 8)
+      ,testCase "ARM case 1" $
+        assertEqual "Period 9"
+        (Just (CF.MortgageFlow (L.toDate "20250101") 129.01 12.46 0.88 0 0 0 0 0.075 Nothing Nothing (Just (110.99,0.00,0.00,0.00,0.00,0.00))))
+        (CF.cfAt arm1_cf 9)
+      ,testCase "ARM case 1" $
+        assertEqual "Period 10"
+        (Just (CF.MortgageFlow (L.toDate "20250201") 116.49 12.52 0.85 0 0 0 0 0.08 Nothing Nothing (Just (123.51,0.00,0.00,0.00,0.00,0.00))))
+        (CF.cfAt arm1_cf 10)
+      ,testCase "ARM case 1" $
+        assertEqual "life cap"
+        (Just (CF.MortgageFlow (L.toDate "20250401") 91.24 12.65 0.77 0 0 0 0 0.09 Nothing Nothing (Just (148.76,0.00,0.00,0.00,0.00,0.00))))
+        (CF.cfAt arm1_cf 12)
+
+    ]
+
+---- prepayment penalty 
+
+ppy_1 = Just $ AB.ByTerm 3 0.1 0.01
+ppy_2 = Just $ AB.FixAmount 100 Nothing
+ppy_2_1 = Just $ AB.FixAmount 100 (Just 2)
+ppy_3 = Just $ AB.FixPct 0.01 Nothing
+ppy_3_1 = Just $ AB.FixPct 0.01 (Just 2)
+ppy_4 = Just $ AB.Sliding 0.1 0.01
+ppy_5 = Just $ AB.StepDown [(2,0.5),(12,0.2)]
+
+origin_info = AB.MortgageOriginalInfo 10000 (Fix DC_ACT_365F 0.08) 24 L.Monthly (L.toDate "20210101") AB.Level Nothing Nothing
+
+tm_ppy_1 = AB.Mortgage (origin_info { AB.prepaymentPenalty = ppy_1}) 10000 0.08 24 Nothing AB.Current
+tm_ppy_2 = AB.Mortgage (origin_info { AB.prepaymentPenalty = ppy_2}) 10000 0.08 24 Nothing AB.Current
+tm_ppy_2_1 = AB.Mortgage (origin_info { AB.prepaymentPenalty = ppy_2_1}) 10000 0.08 24 Nothing AB.Current
+tm_ppy_3 = AB.Mortgage (origin_info { AB.prepaymentPenalty = ppy_3}) 10000 0.08 24 Nothing AB.Current
+tm_ppy_3_1 = AB.Mortgage (origin_info { AB.prepaymentPenalty = ppy_3_1}) 10000 0.08 24 Nothing AB.Current
+tm_ppy_4 = AB.Mortgage (origin_info { AB.prepaymentPenalty = ppy_4}) 10000 0.08 24 Nothing AB.Current
+tm_ppy_5 = AB.Mortgage (origin_info { AB.prepaymentPenalty = ppy_5}) 10000 0.08 24 Nothing AB.Current
+
+ppyTest = 
+  let 
+    assump1 = (A.MortgageAssump Nothing (Just (A.PrepaymentCPR 0.03)) Nothing Nothing,A.DummyDelinqAssump,A.DummyDefaultAssump)
+
+    (ppy_cf_1,_) = case Ast.projCashflow tm_ppy_1 (L.toDate "20210101") assump1 Nothing of 
+                    Left _ -> undefined
+                    Right x -> x
+    (ppy_cf_2,_) = case Ast.projCashflow tm_ppy_2 (L.toDate "20210101") assump1 Nothing of
+                    Left _ -> undefined
+                    Right x -> x
+    (ppy_cf_2_1,_) = case Ast.projCashflow tm_ppy_2_1 (L.toDate "20210101") assump1 Nothing of
+                    Left _ -> undefined
+                    Right x -> x
+    (ppy_cf_3,_) = case Ast.projCashflow tm_ppy_3 (L.toDate "20210101") assump1 Nothing of
+                    Left _ -> undefined
+                    Right x -> x
+    (ppy_cf_3_1,_) = case Ast.projCashflow tm_ppy_3_1 (L.toDate "20210101") assump1 Nothing of
+                    Left _ -> undefined
+                    Right x -> x
+    (ppy_cf_4,_) = case Ast.projCashflow tm_ppy_4 (L.toDate "20210101") assump1 Nothing of
+                    Left _ -> undefined
+                    Right x -> x
+    (ppy_cf_5,_) = case  Ast.projCashflow tm_ppy_5 (L.toDate "20210101") assump1 Nothing of
+                    Left _ -> undefined
+                    Right x -> x
+
+  in 
+    testGroup "Prepay Penalty tests" [
+      testCase "ppy case 1" $
+        assertEqual " using rate0"
+        (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing (Just 2.58) (Just (384.62,25.83,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_1 1)
+      ,testCase "ppy case 1" $
+        assertEqual " using rate1"
+        (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0.21 ) (Just (1548.18,93.84,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_1 4)
+      ,testCase "ppy case 2" $
+        assertEqual " using fix amount"
+        (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 100 ) (Just (1548.18,93.84,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_2 4)
+      ,testCase "ppy case 2 1_0" $
+        assertEqual " using fix amount in period"
+        (Just (CF.MortgageFlow (L.toDate "20210201")  9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing  (Just 100 ) (Just (384.62,25.83,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_2_1 1)
+      ,testCase "ppy case 2 1" $
+        assertEqual " using fix amount out of period"
+        (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0 ) (Just (1548.18,93.84,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_2_1 4)
+      ,testCase "ppy case 3" $
+        assertEqual " using life time pct"
+        (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0.21 ) (Just (1548.18,93.84,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_3 4)
+      ,testCase "ppy case 3 1_0" $
+        assertEqual " using pct in period"
+        (Just (CF.MortgageFlow (L.toDate "20210201")  9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing  (Just 0.25 ) (Just (384.62,25.83,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_3_1 1)
+      ,testCase "ppy case 3 1" $
+        assertEqual " using pct out of period"
+        (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0 ) (Just (1548.18,93.84,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_3_1 4)
+      ,testCase "ppy case 4" $
+        assertEqual " using slide at period 0"
+        (Just (CF.MortgageFlow (L.toDate "20210201")  9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing  (Just 2.58 ) (Just (384.62,25.83,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_4 1)
+      ,testCase "ppy case 4 1" $
+        assertEqual " using slide at period 1"
+        (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just (0.07*21.92)) (Just (1548.18,93.84,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_4 4)     
+      ,testCase "ppy case 5" $
+        assertEqual " using rate 0 before 2 periods"
+        (Just (CF.MortgageFlow (L.toDate "20210201")  9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing  (Just (25.83*0.5) ) (Just (384.62,25.83,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_5 1)
+      ,testCase "ppy case 5 1" $
+        assertEqual " using rate 1 after 2 periods"
+        (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just (0.2*21.92)) (Just (1548.18,93.84,0.00,0.00,0.00,0.00))))
+        (CF.cfAt ppy_cf_5 4)   
+    ]
+
+delinqScheduleCFTest = 
+  let 
+    cfs = [CF.MortgageDelinqFlow (L.toDate "20230901") 1000  0 0 0 0 0 0 0 0.08 Nothing Nothing Nothing
+          ,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,Nothing))
+                  Nothing
+                  (L.toDate "20230801")
+                  Nothing
+                  (Just MonthEnd)
+    assump1 = Just (A.PoolLevel 
+                      (A.MortgageDeqAssump (Just (A.DelinqCDR 0.05 (5,0.3))) Nothing Nothing Nothing
+                      ,A.DummyDelinqAssump
+                      ,A.DummyDefaultAssump))
+    assump2 = Just (A.PoolLevel 
+                      (A.MortgageDeqAssump (Just (A.DelinqCDR 0.05 (5,0.3))) (Just (A.PrepaymentCPR 0.08)) Nothing Nothing
+                      ,A.DummyDelinqAssump
+                      ,A.DummyDefaultAssump))
+
+    poolCf = fst . head $ 
+               case D.runPool pool assump1 Nothing of
+                 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
+                  Right x -> x
+  in 
+    testGroup "delinq run on schedule flow" [
+      testCase "case 01" $
+        assertEqual "size of cashflow" 
+        7
+        (CF.sizeCashFlowFrame poolCf) -- `debug` ("\n>>>>> Pool cf from test schedule delinq\n >>>>"++ show poolCf)
+      ,testCase "case 01_Dates" $
+        assertEqual "Dates of cashflow" 
+        (L.toDate <$> ["20230901","20231001","20231031","20231130","20231231","20240131","20240229"])
+        (CF.getDatesCashFlowFrame poolCf)
+      ,testCase "case 02" $
+        assertEqual "first row of cf"
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230901") 995.66  0 0 0 4.34 0 0 0 0.08 Nothing Nothing (Just (0.00,0.00,4.34,0.00,0.00,0.00))))
+        (CF.cfAt poolCf 0)
+      ,testCase "case 03" $
+        assertEqual "second row of cf"
+        (Just (CF.MortgageDelinqFlow (L.toDate "20231001") 493.66  497.82 0 0 4.18 0 0 0 0.08 Nothing Nothing (Just (497.82,0.00,8.52,0.00,0.00,0.00))))
+        (CF.cfAt poolCf 1)
+      ,testCase "case 04" $
+        assertEqual "first extended cf, nothing"
+        (Just (CF.MortgageDelinqFlow (L.toDate "20231031") 493.66  0.0 0 0 0 0 0 0 0.00 Nothing Nothing (Just (497.82,0.00,8.52,0.00,0.00,0.00))))
+        (CF.cfAt poolCf 2)
+      ,testCase "case 05" $
+        assertEqual "first default from delinq"
+        (Just (CF.MortgageDelinqFlow (L.toDate "20240131") 499.61  0.0 0 0 0 1.3 0 1.3 0.000952 Nothing Nothing (Just (497.82,0.00,8.52,1.30,0.00,1.30))))
+        (CF.cfAt poolCf 5)
+      ,testCase "case 06" $
+        assertEqual "first loss/recovery from default & first back to perf"
+        (Just (CF.MortgageDelinqFlow (L.toDate "20240229") 496.64  2.97 0 0 0 1.25 0 1.25 0.000480 Nothing Nothing (Just (500.79,0.00,8.52,2.55,0.00,2.55))))
+        (CF.cfAt poolCf 6)
+      -- ,testCase "case 07" $
+      --   assertEqual "first loss/recovery from default & first back to perf"
+      --   (Just (CF.MortgageFlow (L.toDate "20240229") 492.36  0.0 0 0 0 1.25 0 1.25 0.0 Nothing Nothing))
+      --   (CF.cfAt poolCf 7)
+      ,testCase "case with prepay assump" $
+        assertEqual "01"
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230901") 988.64 0 0 7.02 4.34  0.0 0.0 0.0 0.08 Nothing Nothing  (Just (0.00,7.02,4.34,0.00,0.00,0.00))))
+        (CF.cfAt poolCf2 0)
+    ]
+
+delinqMortgageTest = 
+  let 
+    tm1 = AB.Mortgage
+           (AB.MortgageOriginalInfo 12 (Fix DC_ACT_365F 0.08) 12 L.Monthly (L.toDate "20210101") AB.Level Nothing Nothing)
+           240 0.08 3
+           Nothing
+           AB.Current
+    assump1 = (A.MortgageDeqAssump   
+                        (Just (A.DelinqCDR 0.05 (2,0.3)))
+                        -- (Just (A.PrepaymentCPR 0.08))
+                        Nothing
+                        Nothing 
+                        Nothing
+              ,A.DummyDelinqAssump,A.DummyDefaultAssump)
+    (CF.CashFlowFrame _ txns,m) = case Ast.projCashflow tm1 (L.toDate "20200101") assump1 Nothing of
+                                    Left _ -> undefined
+                                    Right x -> x
+
+  in 
+    testGroup "Mortgage Delinq Projection" [
+      testCase "" $
+        assertEqual "Length of cf"
+        5
+        (length txns) -- `debug` ("Delinq CF"++show txns)
+      ,testCase "first row" $
+        assertEqual "delinq = 1"
+        (CF.MortgageDelinqFlow (L.toDate "20211101") 159.84 79.12 1.59 0 1.04 0.0 0.0 0.0 0.08 Nothing Nothing (Just (79.12,0.00,1.04,0.00,0.00,0.00)))
+        (txns!!0)
+      ,testCase "second row" $
+        assertEqual "with first default/loss/recovery"
+        (CF.MortgageDelinqFlow (L.toDate "20211201") 79.85 79.32 1.06  0 0.67 0.0 0.0 0.0 0.08 Nothing Nothing (Just (158.44,0.00,1.71,0.00,0.00,0.00)))
+        (txns!!1)
+      ,testCase "last row" $
+        assertEqual "with first default/loss/recovery"
+        (CF.MortgageDelinqFlow (L.toDate "20220101") 1.17 79.75 0.53  0 0.34 0.31 0.0 0.31 0.08 Nothing Nothing (Just (238.19,0.00,2.05,0.31,0.00,0.31)))
+        (txns!!2)
+      ,testCase "extend 1st flow" $
+        assertEqual "check default"
+        (CF.MortgageDelinqFlow (L.toDate "20220201") 0.70 0.47 0.0  0.0 0.0 0.20 0.0 0.2 0.08 Nothing Nothing (Just (238.66,0.00,2.05,0.51,0.00,0.51)))
+        (txns!!3)
+      -- ,testCase "extend 2st flow" $
+      --   assertEqual "check default"
+      --   (CF.MortgageDelinqFlow (L.toDate "20220201") 1.08 0.36 0.0  0.0 0.0 0.11 0.0 0.11 0.08 Nothing Nothing)
+      --   (txns!!4)
+      -- ,testCase "extend 3st flow" $
+      --   assertEqual "check default"
+      --   (CF.MortgageDelinqFlow (L.toDate "20220201") 1.08 0.36 0.0  0.0 0.0 0.0 0.0 0.0 0.08 Nothing Nothing)
+      --   (txns!!5)
+    ]
+
+btlMortgageTest = 
+  let 
+    btl = AB.Mortgage
+            (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 24 L.Monthly (L.toDate "20210101") AB.I_P Nothing Nothing)
+            240 0.08 2
+            Nothing
+            AB.Current
+    assump1 = (A.MortgageAssump   
+                        Nothing
+                        -- (Just (A.PrepaymentCPR 0.08))
+                        Nothing
+                        Nothing 
+                        Nothing
+              ,A.DummyDelinqAssump,A.DummyDefaultAssump)            
+    (CF.CashFlowFrame _ txns,m) = case Ast.projCashflow btl (L.toDate "20200101") assump1 Nothing of 
+                                    Left _ -> undefined
+                                    Right x -> x
+  in 
+    testGroup "Buy to let Mortgage Projection" [
+      testCase "" $
+        assertEqual "Length of cf"
+        3
+        (length txns)
+      ,testCase "extend 1st flow" $
+        assertEqual "1st row"
+        (CF.MortgageFlow (L.toDate "20221201") 240 0 1.59  0.0 0.0 0.0 0.0 0.08 Nothing Nothing (Just (0.0,0.00,0.0,0.0,0.00,0.0)))
+        (txns!!1)
+      ,testCase "extend 1st flow" $
+        assertEqual "last row"
+        (CF.MortgageFlow (L.toDate "20230101") 0 240 1.59  0.0 0.0 0.0 0.0 0.08 Nothing Nothing (Just (240,0.00,0.0,0.0,0.00,0.0)))
+        (txns!!2)
+    ]
+
+nonPayMortgageTest = 
+  let 
+    m = AB.Mortgage
+          (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 24 L.Monthly (L.toDate "20210101") (AB.NO_FirstN 3 AB.Level) Nothing Nothing)
+          240 0.08 24
+          Nothing
+          AB.Current
+    assump1 = (A.MortgageAssump   
+                        Nothing
+                        Nothing
+                        Nothing 
+                        Nothing
+              ,A.DummyDelinqAssump,A.DummyDefaultAssump)
+    (CF.CashFlowFrame _ txns,_) = case Ast.projCashflow m (L.toDate "20200101") assump1 Nothing of 
+                                    Left _ -> undefined
+                                    Right x -> x
+    m1 = AB.Mortgage
+          (AB.MortgageOriginalInfo 240 (Fix DC_ACT_365F 0.08) 24 L.Monthly (L.toDate "20210101") (AB.IO_FirstN 3 AB.Level) Nothing Nothing)
+          240 0.08 24
+          Nothing
+          AB.Current
+    (CF.CashFlowFrame _ txns2,_) = case Ast.projCashflow m1 (L.toDate "20200101") assump1 Nothing of 
+                                     Left _ -> undefined
+                                     Right x -> x
+ 
+  in 
+    testGroup "Non Payment Mortgage Projection" [
+      testCase "NonPay" $
+        assertEqual "Length of cf"
+        25
+        (length txns)
+      ,testCase "first accured" $
+        assertEqual "1st row"
+        (CF.MortgageFlow (L.toDate "20210201") 241.59 (-1.59) 0 0.0 0.0 0.0 0.0 0.08 Nothing Nothing (Just (-1.59,0.00,0.0,0.0,0.00,0.0)))
+        (txns!!1)
+      ,testCase "first amort" $
+        assertEqual "4st row"
+        (CF.MortgageFlow (L.toDate "20210501") 233.92 10.9 1.63 0.0 0.0 0.0 0.0 0.08 Nothing Nothing (Just (6.08,0.00,0.0,0.0,0.00,0.0)))
+        (txns!!4)
+      ,testCase "IO" $
+        assertEqual "Length of cf"
+        25
+        (length txns)
+      ,testCase "first accured" $
+        assertEqual "1st row"
+        (CF.MortgageFlow (L.toDate "20210201") 240 0.0 1.59 0.0 0.0 0.0 0.0 0.08 Nothing Nothing (Just (0,0.0,0.0,0.0,0.00,0.0)))
+        (txns2!!1)
+      ,testCase "first amort" $
+        assertEqual "4st row"
+        (CF.MortgageFlow (L.toDate "20210501") 229.31 10.69 1.59 0.0 0.0 0.0 0.0 0.08 Nothing Nothing (Just (10.69,0.00,0.0,0.0,0.00,0.0)))
+        (txns2!!4)
+      
+    ]
+
+receivableTest = 
+  let 
+    invoice1 = AB.Invoice (AB.ReceivableInfo (L.toDate "20240401") 1500 1000 (L.toDate "20240601") Nothing Nothing) AB.Current
+    invoice2 = AB.Invoice (AB.ReceivableInfo (L.toDate "20240401") 1500 1000 (L.toDate "20240601") (Just (AB.FixedFee 50)) Nothing ) AB.Current
+    invoice0 = AB.Invoice (AB.ReceivableInfo (L.toDate "20240401") 1500 1000 (L.toDate "20240601") Nothing Nothing) (AB.Defaulted Nothing)
+    invoiceAssump = (A.ReceivableAssump   
+                        Nothing
+                        Nothing 
+                        Nothing
+                    ,A.DummyDelinqAssump,A.DummyDefaultAssump)
+  in 
+    testGroup "Invoice CF test" [
+      testCase "Plain Receivable" $
+        assertEqual "Last Payment"
+        (Right (Just (CF.ReceivableFlow (L.toDate "20240601") 0 0 1500 0 0 0 0 (Just (0.0,0.0,0.0,0.0,0.0,0.0)))))
+        ((`CF.cfAt` 1) <$>  (fst <$> Ast.projCashflow invoice1 (L.toDate "20240101") invoiceAssump Nothing) )
+      ,testCase "Fix Fee" $
+        assertEqual "Last Payment"
+        (Right (Just (CF.ReceivableFlow (L.toDate "20240601") 0 0 1450 50 0 0 0 (Just (0.0,0.0,0.0,0.0,0.0,0.0)))))
+        ((`CF.cfAt` 1) <$> (fst <$> Ast.projCashflow invoice2 (L.toDate "20240101") invoiceAssump Nothing))
+      ,testCase "Defaulted invoice" $
+        assertEqual "Defauted invoice "
+        (Right (Just (CF.ReceivableFlow (L.toDate "20240501") 0 0 0 0 1500 0 1500.0 (Just (0.0,0.0,0.0,1500.0,0.0,1500.0)))))
+        ((`CF.cfAt` 0) <$> (fst <$> Ast.projCashflow invoice0 (L.toDate "20240501") invoiceAssump Nothing))
+    ]
+  
+fixedAssetTest = 
+  let 
+    assetInfo = AB.FixedAssetInfo (L.toDate "20250101") 11000 1000 10 Monthly AB.StraightLine (AB.FixedCapacity 100)
+    assetInfo2 = AB.FixedAssetInfo (L.toDate "20250101") 10000 1000 10 Monthly AB.DecliningBalance (AB.FixedCapacity 100)
+    asset = AB.FixedAsset assetInfo 11000 10
+    priceCurve = L.mkTs [(L.toDate "20250101",50), (L.toDate "20251231", 150)]
+    utilCurve = L.mkTs [(L.toDate "20250101",1.0), (L.toDate "20251231", 1.0)]
+  in 
+    testGroup "fixed Asset Test" [
+      testCase "StraightLine:init Asset: size" $ 
+        assertEqual "StraightLine:init Asset: size"
+        (Right 10)
+        (let 
+            asset1 = asset
+          in 
+            (CF.sizeCashFlowFrame <$> (fst <$> (Ast.projCashflow asset1 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve  Nothing) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "StraightLine:init Asset with ext " $ 
+        assertEqual "StraightLine:init Asset"
+        (Right (Just (CF.FixedFlow (L.toDate "20260201") 1000 0 10000 100.0 15000.0)))
+        (let 
+            asset1 = asset
+          in 
+            ((`CF.cfAt` 12) <$> (fst <$> (Ast.projCashflow asset1 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve (Just 3)) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "StraightLine:init Asset with diff cur balance " $ 
+        assertEqual "StraightLine:init Asset"
+        (Right (Just (CF.FixedFlow (L.toDate "20250701") 3400 600.0 7600 100.0 5000.0)))
+        (let 
+            asset2 = AB.FixedAsset assetInfo 4000 5
+          in 
+            ((`CF.cfAt` 0) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve Nothing) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "StraightLine:init Asset with diff cur balance " $ 
+        assertEqual "StraightLine:init Asset"
+        (Right (Just (CF.FixedFlow (L.toDate "20260201") 1000 0 10000 100.0 15000.0)))
+        (let 
+            asset2 = AB.FixedAsset assetInfo 4000 5
+          in 
+            ((`CF.cfAt` 7) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve (Just 3)) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "StraightLine:init Asset with diff cur balance " $ 
+        assertEqual "StraightLine:init Asset"
+        (Right (Just (CF.FixedFlow (L.toDate "20251101") 1000 3000 10000 100.0 5000.0)))
+        (let 
+            asset2 = AB.FixedAsset assetInfo 4000 1
+          in 
+            ((`CF.cfAt` 0) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve (Just 3)) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "Double Decline:size" $ 
+        assertEqual "Double Decline:size "
+        (Right 10)
+        (let 
+            asset2 = AB.FixedAsset assetInfo2 10000 10
+          in 
+            (CF.sizeCashFlowFrame <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve Nothing) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "Double Decline:first row with full cur bal" $ 
+        assertEqual "Double Decline:init Asset"
+        (Right (Just (CF.FixedFlow (L.toDate "20250201") 8000 2000 2000 100.0 5000.0)))
+        (let 
+            asset2 = AB.FixedAsset assetInfo2 10000 10
+          in 
+            ((`CF.cfAt` 0) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve (Just 3)) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "Double Decline:init Asset :last" $ 
+        assertEqual "Double Decline:init Asset :last"
+        (Right (Just (CF.FixedFlow (L.toDate "20251101") 1000.0 338.86 9000.0 100.0 5000.0)))
+        (let 
+            asset2 = AB.FixedAsset assetInfo2 10000 10
+          in 
+            ((`CF.cfAt` 9) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve Nothing) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+      ,testCase "Double Decline:init Asset: with ext periods" $ 
+        assertEqual "Double Decline:init Asset: with ext periods"
+        (Right (Just (CF.FixedFlow (L.toDate "20260201") 1000.00 0.0 9000 100.0 15000.0)))
+        (let 
+            asset2 = AB.FixedAsset assetInfo2 10000 10
+          in 
+            ((`CF.cfAt` 12) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+                                  ((A.FixedAssetAssump utilCurve priceCurve (Just 3)) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+
+      -- ,testCase "Double Decline" $ 
+      --   assertEqual "Double Decline:init Asset : current with less balance "
+      --   (Right (Just (CF.FixedFlow (L.toDate "20251101") 1073.73 268.44 8926.27 100.0 5000.0)))
+      --   (let 
+      --       asset2 = AB.FixedAsset assetInfo2 5000 5
+      --     in 
+      --       ((`CF.cfAt` 9) <$> (fst <$> (Ast.projCashflow asset2 (L.toDate "20240101") 
+      --                             ((A.FixedAssetAssump utilCurve priceCurve Nothing) ,A.DummyDelinqAssump ,A.DummyDefaultAssump) Nothing))))
+    ]
diff --git a/test/UT/BondTest.hs b/test/UT/BondTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/BondTest.hs
@@ -0,0 +1,236 @@
+module UT.BondTest(pricingTests,bndConsolTest,writeOffTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import qualified Liability as B
+import qualified Deal as D
+import qualified Lib as L
+import qualified Stmt  as S
+import qualified Asset as P
+import qualified Assumptions as A
+import qualified Cashflow as CF
+import qualified Data.DList as DL
+import Util
+import Types
+import Data.Ratio
+
+import Debug.Trace
+debug = flip trace
+
+b1Txn =  DL.fromList [ BondTxn (L.toDate "20220501") 1500 10 500 0.08 510 0 0 Nothing S.Empty
+          ,BondTxn (L.toDate "20220801") 0 10 1500 0.08 1510 0 0 Nothing S.Empty ]
+b1 = B.Bond{B.bndName="A"
+            ,B.bndType=B.Sequential
+            ,B.bndOriginInfo= B.OriginalInfo{
+                               B.originBalance=3000
+                               ,B.originDate= T.fromGregorian 2021 1 1
+                               ,B.originRate= 0.08
+                               ,B.maturityDate = Nothing}
+            ,B.bndInterestInfo= B.Fix 0.08 DC_ACT_365F
+            ,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
+            ,B.bndLastIntPay = Just (T.fromGregorian 2021 1 1)
+            ,B.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+            ,B.bndStmt=Just (S.Statement b1Txn)}
+
+bfloat = B.Bond{B.bndName="A"
+            ,B.bndType=B.Sequential
+            ,B.bndOriginInfo= B.OriginalInfo{
+                               B.originBalance=3000
+                               ,B.originDate= T.fromGregorian 2022 1 1
+                               ,B.originRate= 0.08
+                               ,B.maturityDate = Nothing}
+            ,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
+            ,B.bndDueIntOverInt=0.0
+            ,B.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+            ,B.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+            ,B.bndStmt=Just $ S.Statement (DL.fromList [ BondTxn (L.toDate "20220501") 1500 10 500 0.08 510 0 0 Nothing S.Empty])}
+
+
+pricingTests = testGroup "Pricing Tests"
+  [
+    let
+      _ts = L.PricingCurve [L.TsPoint (L.toDate "20210101") 0.05, L.TsPoint (L.toDate "20240101") 0.05]
+      _pv_day = L.toDate "20220201"
+      _f_day = L.toDate "20230201"
+      _pv = B.pv _ts _pv_day _f_day 103
+    in
+      testCase "PV test" $
+        assertEqual "simple PV with flat curve"  
+          98.09
+          _pv,
+    let
+        _pv_day = L.toDate "20220201"
+        _f_day = L.toDate "20230201"
+        _ts1 = L.PricingCurve [L.TsPoint (L.toDate "20210101") 0.01, L.TsPoint (L.toDate "20230101") 0.03]
+        _pv1 = B.pv _ts1 _pv_day _f_day 103
+        _diff1 = _pv1 - 100.0
+    in
+      testCase "PV test with curve change in middle" $
+      assertEqual "simple PV with latest rate point" 100.0 _pv1
+   ,
+    let
+      pr = B.priceBond (L.toDate "20210501")
+                       (L.PricingCurve [L.TsPoint (L.toDate "20210101") 0.01, L.TsPoint (L.toDate "20230101") 0.02])
+                       b1
+    in
+      testCase "flat rate discount " $
+      assertEqual "Test Pricing on case 01" 
+        (PriceResult 1978.47 65.949000 1.18 1.1881448 0.4906438 52.60 (DL.toList b1Txn)) 
+        pr
+    ,
+     let
+       b2Txn =  DL.fromList [BondTxn (L.toDate "20220301") 3000 10 300 0.08 310 0 0 Nothing S.Empty
+                           ,BondTxn (L.toDate "20220501") 2700 10 500 0.08 510 0 0 Nothing S.Empty
+                           ,BondTxn (L.toDate "20220701") 0 10 3200 0.08 3300 0 0 Nothing S.Empty]
+       b2 = b1 { B.bndStmt = Just (S.Statement b2Txn)}
+
+       pr = B.priceBond (L.toDate "20220201")
+                        (L.PricingCurve
+                            [L.TsPoint (L.toDate "20220101") 0.01
+                            ,L.TsPoint (L.toDate "20220401") 0.03
+                            ,L.TsPoint (L.toDate "20220601") 0.05])
+                        b2
+     in
+       testCase " discount curve with two rate points " $
+       assertEqual "Test Pricing on case 01" 
+            (PriceResult 4049.10 134.97 0.44 0.364564 0.006030 286.42 (DL.toList b2Txn)) 
+            pr  --TODO need to confirm in UI
+    ,
+    let
+      b4 = b1
+      pday = L.toDate "20220801"
+    in
+      testCase "pay prin to a bond" $
+      assertEqual "pay down prin" 2400  $ B.bndBalance (B.payPrin pday 600 b4)
+    ,
+    let
+      b5 = b1
+      pday = L.toDate "20220801"
+    in
+      testCase "pay int to 2 bonds" $
+      assertEqual "pay int" 2400  $ B.bndBalance (B.payPrin pday 600 b5)
+    ,
+    let 
+      newCfStmt = Just $ S.Statement (DL.fromList [ BondTxn (L.toDate "20220501") 1500 300 2800 0.08 3100 0 0 Nothing S.Empty]) 
+      b6 = b1 {B.bndStmt = newCfStmt}
+      pday = L.toDate "20220301" -- `debug` ("stmt>>>>>"++ show (B.bndStmt b6))
+      rateCurve = IRateCurve [TsPoint (L.toDate "20220201") 0.03 ,TsPoint (L.toDate "20220401") 0.04]
+      --rateCurve = IRateCurve [TsPoint (L.toDate "20220201") 0.03::IRate]
+    in 
+      testCase "Z spread test" $
+      assertEqual "Z spread test 01" 
+      (Right 0.176754)
+      (B.calcZspread  (100.0,pday) b6 rateCurve)
+      --(B.calcZspread  (500.0,pday) (103.0,1/100) Nothing rateCurve)
+
+  ]
+
+bndTests = testGroup "Float Bond Tests" [
+    let
+       r1 = B.isAdjustble  (B.bndInterestInfo bfloat)
+       r2 = B.isAdjustble (B.bndInterestInfo bfloat)
+    in
+      testCase "Adjust rate by Month of Year " $
+      assertEqual "" [True,False] [r1,r2]
+    ,
+    let 
+       bfloatResetInterval = bfloat {B.bndInterestInfo = B.Floater 
+                                                         0.01
+                                                         LPR5Y 
+                                                         0.015 
+                                                         QuarterEnd
+                                                         DC_ACT_365F   
+                                                         Nothing Nothing}
+       r1 = B.isAdjustble $ B.bndInterestInfo bfloatResetInterval
+       r2 = B.isAdjustble $ B.bndInterestInfo bfloatResetInterval
+    in 
+      testCase "Adjust rate by quarter  " $
+      assertEqual "" [True,False] [r1,r2]
+ ]
+
+
+bndConsolTest = testGroup "Bond consoliation & patchtesting" [
+    let 
+      b1f = S.getTxns . B.bndStmt $ B.patchBondFactor b1
+    in 
+      testCase "test on patching bond factor" $
+      assertEqual ""
+      (DL.fromList [ BondTxn (L.toDate "20220501") 1500 10 500 0.08 510 0 0 (Just 0.5) S.Empty
+       ,BondTxn (L.toDate "20220801") 0 10 1500 0.08 1510 0 0 (Just 0.0) S.Empty
+      ])
+      b1f,
+    let 
+      txns = DL.fromList [BondTxn (L.toDate "20220501") 1500 0 (-500) 0.08 0 0 0 (Just 0.5) S.Empty
+              ,BondTxn (L.toDate "20220501") 2000 0 (-500) 0.08 0 0 0 (Just 0.0) S.Empty]
+      bTest = b1 {B.bndStmt = Just (S.Statement txns)}
+      bTestConsol = B.bndStmt $ B.consolStmt bTest
+    in
+      testCase "merge txn with two drawdowns" $
+      assertEqual ""
+      (Just (S.Statement (DL.fromList [ BondTxn (L.toDate "20220501") 2000 0 (-1000) 0.08 0 0 0 (Just 0.0) (S.TxnComments [S.Empty, S.Empty])])))
+      bTestConsol,
+    let 
+      txns = DL.fromList [ BondTxn (L.toDate "20220501") 1500 0 (-500) 0.08 0 0 0 (Just 0.5) S.Empty
+              ,BondTxn (L.toDate "20220501") 1500 0 500 0.08 0 0 0 (Just 0.0) S.Empty]
+      bTest = b1 {B.bndStmt = Just (S.Statement txns)}
+      bTestConsol = B.bndStmt $ B.consolStmt bTest
+    in
+      testCase "merge txn with one drawdown at begin" $
+      assertEqual ""
+      (Just (S.Statement (DL.fromList [ BondTxn (L.toDate "20220501") 1500 0 0 0.08 0 0 0 (Just 0.0) (S.TxnComments [S.Empty, S.Empty])])))
+      bTestConsol,
+    let 
+      txns = DL.fromList [BondTxn (L.toDate "20220501") 1500 0 500 0.08 0 0 0 (Just 0.0) S.Empty,
+              BondTxn (L.toDate "20220501") 2000 0 (-500) 0.08 0 0 0 (Just 0.5) S.Empty]
+      bTest = b1 {B.bndStmt = Just (S.Statement txns)}
+      bTestConsol = B.bndStmt $ B.consolStmt bTest
+    in
+      testCase "merge txn with one drawdown at end" $
+      assertEqual ""
+      (Just (S.Statement (DL.fromList [ BondTxn (L.toDate "20220501") 2000 0 0 0.08 0 0 0 (Just 0.5) (S.TxnComments [S.Empty, S.Empty])])))
+      bTestConsol,
+    let 
+      txns = DL.fromList [BondTxn (L.toDate "20220501") 1500 0 500 0.08 0 0 0 (Just 0.0) S.Empty,
+              BondTxn (L.toDate "20220501") 1000 0 500 0.08 0 0 0 (Just 0.5) S.Empty]
+      bTest = b1 {B.bndStmt = Just (S.Statement txns)}
+      bTestConsol = B.bndStmt $ B.consolStmt bTest
+    in
+      testCase "merge txn with one drawdown at end" $
+      assertEqual ""
+      (Just (S.Statement (DL.fromList [ BondTxn (L.toDate "20220501") 1000 0 1000 0.08 0 0 0 (Just 0.5) (S.TxnComments [S.Empty, S.Empty])])))
+      bTestConsol
+    ]
+
+
+writeOffTest = 
+  let 
+    d1 = L.toDate "20200101"
+    bnd1 = B.Bond "A" B.Sequential (B.OriginalInfo 100 d1 0.06 Nothing) (B.Fix 0.05 DC_ACT_365F) Nothing 100 0.08 0 0 0 Nothing Nothing Nothing Nothing
+    writeAmt1 = 70 
+    writeAmt2 = 120 
+  in 
+  testGroup "write off on bond" [
+    testCase "write off on bond 1" $
+    assertEqual "only 1st bond is written off by 70"
+    (Right (bnd1 {B.bndBalance = 30,B.bndStmt = Just (S.Statement (DL.fromList [S.BondTxn d1 30.00 0.00 0.00 0.000000 0.00 0.00 0.00 Nothing (S.WriteOff "A" 70.00)]))}))
+    (B.writeOff d1 writeAmt1 bnd1),
+    testCase "over write off on bond 1" $
+    assertEqual "over write off on bond 1"
+    (Left "Insufficient balance to write off 120.00\" bond name \"\"A\"")
+    (B.writeOff d1 writeAmt2 bnd1)
+  ]
diff --git a/test/UT/CashflowTest.hs b/test/UT/CashflowTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/CashflowTest.hs
@@ -0,0 +1,463 @@
+module UT.CashflowTest(cfTests,tsSplitTests,testMergePoolCf,combineTest,testHaircut
+                      ,testMergeTsRowsFromTwoEntities,testCumStat,testClawIntTest,testPoolAggTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import qualified Lib as L
+import qualified Asset as P
+import qualified Pool
+import qualified Data.Map as Map
+import qualified Assumptions as A
+import qualified Cashflow as CF
+import Types
+import Util
+import DateUtil
+
+import Debug.Trace
+debug = flip trace
+
+dummySt = (0,L.toDate "19000101",Nothing)
+
+trs = [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing Nothing
+      , CF.MortgageFlow (L.toDate "20220201") 90 10 10 0 0 0 0 0 Nothing Nothing Nothing
+      , CF.MortgageFlow (L.toDate "20220211") 80 10 10 0 0 0 0 0 Nothing Nothing Nothing
+      , CF.MortgageFlow (L.toDate "20220301") 70 10 10 0 0 0 0 0 Nothing Nothing Nothing]
+
+cf = CF.CashFlowFrame dummySt trs
+
+aggTs1 = CF.aggTsByDates trs [L.toDate "20220110"]
+aggTs2 = CF.aggTsByDates trs [L.toDate "20220210"]
+aggTs3 = CF.aggTsByDates trs [L.toDate "20220101",L.toDate "20220208"]
+aggTs4 = CF.aggTsByDates trs [L.toDate "20220101",L.toDate "20220218"]
+
+findLatestCf1 = CF.getTxnLatestAsOf cf (L.toDate "20220215")
+findLatestCf2 = CF.getTxnLatestAsOf cf (L.toDate "20220315")
+findLatestCf3 = CF.getTxnLatestAsOf cf (L.toDate "20210315")
+
+cfTests = testGroup "Cashflow Utils"
+  [
+    testCase "Cashflow Aggregation only one return" $
+     assertEqual "only one ts" 1 (length aggTs1)
+   ,testCase "Cashflow Aggregation agg correct amount" $
+     assertEqual "which bal is 100"
+       (CF.MortgageFlow (L.toDate "20220110") 100 10 10 0 0 0 0 0 Nothing Nothing Nothing)
+       (head aggTs1)
+   ,testCase "Cashflow Aggregation Sum up" $
+     assertEqual "Test Sum up" 1 (length aggTs2)
+   ,testCase "Cashflow Aggregation agg correct amount" $
+     assertEqual "which bal is 90"
+       (CF.MortgageFlow (L.toDate "20220210") 90 20 20 0 0 0 0 0 Nothing Nothing Nothing)
+       (head aggTs2)
+
+   ,testCase "Cashflow Aggregation with two dates" $
+     assertEqual "Test Sum up" 2 (length aggTs3)
+   ,testCase "Cashflow Aggregation agg correct amount" $
+     assertEqual "which bal is 90"
+        [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing Nothing
+        ,CF.MortgageFlow (L.toDate "20220208") 90 10 10 0 0 0 0 0  Nothing Nothing Nothing]
+        aggTs3
+
+   ,testCase "Cashflow Aggregation with two flows at second cutoff" $
+     assertEqual "include two cf in one cutoff date"
+       [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing Nothing
+       ,CF.MortgageFlow (L.toDate "20220218") 80 20 20 0 0 0 0 0  Nothing Nothing Nothing]
+       aggTs4
+   ,testCase "Cashflow Aggregation" $
+     assertEqual "aggregate period with no cf"
+       [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing Nothing
+       ,CF.MortgageFlow (L.toDate "20220102") 100 0 0 0 0 0 0 0 Nothing Nothing Nothing
+       ,CF.MortgageFlow (L.toDate "20220111") 100 0 0 0 0 0 0 0 Nothing Nothing Nothing
+       ]
+       (CF.aggTsByDates trs (L.toDates ["20220101","20220102","20220111"]))
+
+   ,testCase "Get Latest Cashflow 1" $
+     assertEqual "Found one"
+       (Just $ CF.MortgageFlow (L.toDate "20220211") 80 10 10 0 0 0 0 0 Nothing Nothing Nothing)
+       findLatestCf1
+   ,testCase "Get Latest Cashflow 2" $
+     assertEqual "Found one"
+       (Just (CF.MortgageFlow (L.toDate "20220301") 70 10 10 0 0 0 0 0 Nothing Nothing Nothing))
+       findLatestCf2
+   ,testCase "Get Latest Cashflow 3" $
+     assertEqual "Nothing found"
+       Nothing
+       findLatestCf3
+    ]
+
+
+tsSplitTests = 
+    let 
+      cf1 = CF.CashFlow (L.toDate "20230101") 100
+      cf2 = CF.CashFlow (L.toDate "20230201") 100
+      cf3 = CF.CashFlow (L.toDate "20230301") 100
+      cf4 = CF.CashFlow (L.toDate "20230401") 100
+      ts1 = [cf1,cf2,cf3,cf4]
+      ts2 = [cf1,cf2,cf2,cf3,cf4]
+      cff = CF.CashFlowFrame dummySt [cf1,cf2,cf3,cf4]
+    in 
+      testGroup "Slice Time Series" 
+      [ testCase "Cashflow" $
+          assertEqual "by middle left"
+          ([cf1,cf2],[cf3,cf4]) $
+          splitByDate ts1 (L.toDate "20230215") EqToLeft
+        ,testCase "Cashflow" $
+          assertEqual "on left" 
+          ([cf1,cf2,cf3],[cf4]) $
+          splitByDate ts1 (L.toDate "20230301") EqToLeft
+        ,testCase "Cashflow" $
+          assertEqual "on right"
+          ([cf1,cf2],[cf3,cf4]) $
+          splitByDate ts1 (L.toDate "20230301") EqToRight
+        ,testCase "Cashflow" $
+          assertEqual "by middle right"
+          ([cf1],[cf2, cf3,cf4]) $
+          splitByDate ts1 (L.toDate "20230110") EqToRight
+        ,testCase "Cashflow" $
+          assertEqual "Keep previous one"
+          ([cf1],[cf2, cf3,cf4]) $
+          splitByDate ts1 (L.toDate "20230210") EqToLeftKeepOne
+        ,testCase "Cashflow" $
+          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] $
+          sliceBy II (L.toDate "20230201") (L.toDate "20230401") ts1
+        ,testCase "Range of Ts" $
+          assertEqual "get subset of Ts between two dates"
+          [cf3,cf4] $
+          sliceBy EI (L.toDate "20230201") (L.toDate "20230401") ts1
+        ,testCase "Range of Ts" $
+          assertEqual "get subset of Ts between two dates"
+          [cf2, cf3] $
+          sliceBy IE (L.toDate "20230201") (L.toDate "20230401") ts1
+        ,testCase "Range of Ts" $
+          assertEqual "get subset of Ts between two dates"
+          [cf3] $
+          sliceBy EE (L.toDate "20230201") (L.toDate "20230401") ts1
+      ]
+
+combineTest = 
+  let 
+    txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+    txn2 = CF.MortgageFlow (L.toDate "20230201") 90 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+    txn3 = CF.MortgageFlow (L.toDate "20230301") 50 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+    txn4 = CF.MortgageFlow (L.toDate "20230401") 40 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+    cf1 = CF.CashFlowFrame dummySt [txn1,txn2] 
+    cf2 = CF.CashFlowFrame dummySt [txn3,txn4] 
+  in 
+    testGroup "Combine Cashflow Test"
+    [ testCase "No overlap combine" $
+        assertEqual "No overlap combine"
+        (CF.CashFlowFrame dummySt 
+          [CF.MortgageFlow (L.toDate "20230101") 160 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          ,CF.MortgageFlow (L.toDate "20230201") 150 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          ,CF.MortgageFlow (L.toDate "20230301") 140 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          ,CF.MortgageFlow (L.toDate "20230401") 130 10 10 0 0 0 0 0.0 Nothing Nothing Nothing])
+        (CF.combine cf1 cf2)
+      ,testCase "Overlap combine" $
+        let 
+          txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          txn2 = CF.MortgageFlow (L.toDate "20230201") 90 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          txn3 = CF.MortgageFlow (L.toDate "20230301") 80 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          cf1 = CF.CashFlowFrame dummySt [txn1,txn2] 
+          cf2 = CF.CashFlowFrame dummySt [txn2,txn3] 
+        in 
+          assertEqual "Overlap combine"
+          (CF.CashFlowFrame dummySt $
+            [CF.MortgageFlow (L.toDate "20230101") 200 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+            ,CF.MortgageFlow (L.toDate "20230201") 180 20 20 0 0 0 0 0.0 Nothing Nothing Nothing
+            ,CF.MortgageFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0.0 Nothing Nothing Nothing])
+          (CF.combine cf1 cf2)
+       ,testCase "Intersection" $
+        let 
+          txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          txn2 = CF.MortgageFlow (L.toDate "20230201") 80 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          txn3 = CF.MortgageFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          txn4 = CF.MortgageFlow (L.toDate "20230401") 70 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+          cf1 = CF.CashFlowFrame dummySt [txn1,txn3] 
+          cf2 = CF.CashFlowFrame dummySt [txn2,txn4] 
+        in 
+          assertEqual "Intersection CF"
+          (CF.CashFlowFrame dummySt $
+            [CF.MortgageFlow (L.toDate "20230101") 190 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+            ,CF.MortgageFlow (L.toDate "20230201") 180 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+            ,CF.MortgageFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0.0 Nothing Nothing Nothing
+            ,CF.MortgageFlow (L.toDate "20230401") 160 10 10 0 0 0 0 0.0 Nothing Nothing Nothing])
+          (CF.combine cf1 cf2)
+    ]
+
+
+testMergeTsRowsFromTwoEntities = 
+  let 
+    txn1 = CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+    txn4 = CF.MortgageDelinqFlow (L.toDate "20230401") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+    
+    txn2 = CF.MortgageDelinqFlow (L.toDate "20230201") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+    txn3 = CF.MortgageDelinqFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+  in
+    testGroup "Merge Two CF from two entities"
+    [testCase "txn1 + txn 2" $ 
+      assertEqual "Merge Two CF from two entities"
+      [CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+       ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing]
+      (CF.combineTss [] [txn1] [txn2])
+    ,testCase "txn1 + txn 2/3" $ 
+      assertEqual "Merge Two CF from two entities"
+      [CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+       ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+       ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing]
+      (CF.combineTss [] [txn1] [txn2,txn3])
+    ,testCase "txn1/4 + txn 2/3" $ 
+      assertEqual "Merge Two CF from two entities"
+      [CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+       ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+       ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+       ,CF.MortgageDelinqFlow (L.toDate "20230401") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing ]
+      (CF.combineTss [] [txn1,txn4] [txn2,txn3])
+    ,testCase "txn1/2 + txn 1/2" $
+      assertEqual "Merge Two CF from two entities with same dates"
+      [CF.MortgageDelinqFlow (L.toDate "20230101") 200 20 20 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+       ,CF.MortgageDelinqFlow (L.toDate "20230201") 180 20 20 0 0 0 0 0 0.0 Nothing Nothing Nothing]
+      (CF.combineTss [] [txn1,txn2] [txn1,txn2])
+    ,testCase "txn1/2/3 + txn 1/2" $
+      assertEqual "Merge Two CF from two entities with same dates"
+      [CF.MortgageDelinqFlow (L.toDate "20230101") 200 20 20 0 0 0 0 0 0.0 Nothing Nothing Nothing 
+       ,CF.MortgageDelinqFlow (L.toDate "20230201") 180 20 20 0 0 0 0 0 0.0 Nothing Nothing Nothing
+       ,CF.MortgageDelinqFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+       ]
+      (CF.combineTss [] [txn1,txn2,txn3] [txn1,txn2])
+      
+      
+      ]
+
+
+
+testMergePoolCf = 
+  let 
+    txn1 = CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+    txn2 = CF.MortgageDelinqFlow (L.toDate "20230201") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+    txn3 = CF.MortgageDelinqFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+    txn4 = CF.MortgageDelinqFlow (L.toDate "20230401") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing Nothing
+    
+    cf1 = CF.CashFlowFrame (110, L.toDate "20221201", Nothing) [txn1,txn4]
+    cf2 = CF.CashFlowFrame (110, L.toDate "20230101", Nothing) [txn2,txn3]
+
+    cf3 = CF.CashFlowFrame (110, L.toDate "20221201", Nothing) [txn2,txn4]
+    cf4 = CF.CashFlowFrame (110, L.toDate "20221201", Nothing) [txn1,txn3]
+
+    cf5 = CF.CashFlowFrame (100, L.toDate "20221201", Nothing) [txn3,txn4]
+    cf6 = CF.CashFlowFrame (110, L.toDate "20230101", Nothing) [txn2]
+
+  in 
+    testGroup "Merge Cashflow Test from two entities"  -- merge cashflow into existing one without update previous balance
+    [ testCase "Merge Cashflow Test 1" $
+        assertEqual ""
+        (CF.CashFlowFrame (110 , L.toDate "20221201", Nothing)
+                           [(CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (10,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (20,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (30,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230401") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (40,0,0,0,0,0)))]) 
+        (CF.mergePoolCf2 cf1 cf2)
+      ,testCase "Merge Cashflow with same begin date 1" $
+        assertEqual ""
+        (CF.CashFlowFrame (220 , L.toDate "20221201", Nothing)
+                           [(CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (10,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (20,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (30,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230401") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (40,0,0,0,0,0)))]) 
+        (CF.mergePoolCf2 cf3 cf4)
+      ,testCase "Merge Cashflow with diff begin date 2" $
+        assertEqual ""
+        (CF.CashFlowFrame (100 , L.toDate "20221201", Nothing)
+                           [(CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (10,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (20,0,0,0,0,0)))
+                           ,(CF.MortgageDelinqFlow (L.toDate "20230401") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing (Just (30,0,0,0,0,0)))]) 
+        (CF.mergePoolCf2 cf5 cf6)
+      ]
+
+testHaircut = 
+  let 
+    cflow = CF.CashFlowFrame dummySt [(CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 0 0 5  0 0.0 Nothing (Just 10) Nothing)
+                             ,(CF.MortgageDelinqFlow (L.toDate "20230201") 200 30 20 30 0 0 10 0 0.0 Nothing (Just 15) Nothing)
+                             ,(CF.MortgageDelinqFlow (L.toDate "20230301") 190 40 30 40 0 0 15 0 0.0 Nothing (Just 20) Nothing)
+                             ,(CF.MortgageDelinqFlow (L.toDate "20230401") 180 50 40 50 0 0 20 0 0.0 Nothing (Just 30) Nothing)]
+  in 
+    testGroup "Test on Haircut"
+    [ testCase "Haircut of Nothing" $
+        assertEqual "" 
+        cflow 
+        (P.applyHaircut Nothing cflow)
+    ,testCase "Haircut on principal" $
+        assertEqual "" 
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 10 20 0 0 5  0 0.0 Nothing (Just 10) Nothing ))
+        (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrincipal,0.5)]}) cflow) 0)
+    ,testCase "Haircut on interest" $
+        assertEqual "" 
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 7 20 0 0 5  0 0.0 Nothing (Just 10) Nothing))
+        (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedInterest,0.3)]}) cflow) 0)
+    ,testCase "Haircut on prepayment" $
+        assertEqual "" 
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 12 0 0 5  0 0.0 Nothing (Just 10) Nothing))
+        (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrepayment,0.4)]}) cflow) 0)
+    ,testCase "Haircut on recoveries" $
+        assertEqual "" 
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 0 0 4.5  0 0.0 Nothing (Just 10) Nothing))
+        (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedRecoveries,0.1)]}) cflow) 0)
+    ,testCase "Haircut on prepay penalty" $
+        assertEqual "" 
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 0 0 5  0 0.0 Nothing (Just 8) Nothing))
+        (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrepaymentPenalty,0.2)]}) cflow) 0)
+    ,testCase "Haircut on mix" $
+        assertEqual "" 
+        (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 7 20 0 0 5  0 0.0 Nothing (Just 8) Nothing))
+        (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrepaymentPenalty,0.2)
+                                                                          ,(CollectedPrincipal,0.5)
+                                                                          ,(CollectedInterest,0.3)]}) cflow) 0)
+    ]
+
+testCumStat = 
+  let 
+    cflow =[CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 1 2 3 4 0.0 Nothing (Just 10) Nothing
+           ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 30 20 30 1 2 3 4 0.0 Nothing (Just 15) Nothing
+           ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 40 30 40 1 2 3 4 0.0 Nothing (Just 20) Nothing
+           ,CF.MortgageDelinqFlow (L.toDate "20230401") 180 50 40 50 1 2 3 4 0.0 Nothing (Just 30) Nothing]
+
+    cflow1 = [CF.MortgageDelinqFlow (L.toDate "20230201") 200 30 20 30 1 2 3 4 0.0 Nothing (Just 15) (Just (30,30,1,2,3,4))
+             ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 40 30 40 1 2 3 4 0.0 Nothing (Just 20) (Just (70,70,2,4,6,8))
+             ,CF.MortgageDelinqFlow (L.toDate "20230401") 180 50 40 50 1 2 3 4 0.0 Nothing (Just 30) (Just (120,120,3,6,9,12))]
+    
+    cflow2 =[CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 1 2 3 4 0.0 Nothing (Just 10) Nothing
+        ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 30 20 30 1 2 3 4 0.0 Nothing (Just 15) Nothing
+        ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 40 30 40 1 2 3 4 0.0 Nothing (Just 20) Nothing
+        ,CF.MortgageDelinqFlow (L.toDate "20230401") 180 50 40 50 1 2 3 4 0.0 Nothing (Just 30) Nothing]
+  in 
+    testGroup "Test on calc CumStat"
+    [ testCase "MortDelinq CumStat" $
+        assertEqual "" 
+        cflow1
+        (fst (CF.cutoffTrs (L.toDate "20230201") cflow))
+      ,testCase "Sum on pool fields-prin" $
+        assertEqual "sum principal"
+        120.0
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) CollectedPrincipal)
+      ,testCase "Sum on pool fields-int" $
+        assertEqual "sum interest"
+        90.0
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) CollectedInterest)
+      ,testCase "Sum on pool fields-ppy" $
+        assertEqual "sum prepayment"
+        120.0
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) CollectedPrepayment)
+      ,testCase "Sum on pool fields-delinq" $
+        assertEqual "sum delinq"
+        3.0
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) NewDelinquencies)
+      ,testCase "Sum on pool fields-default" $
+        assertEqual "sum default"
+        6
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) NewDefaults)
+      ,testCase "Sum on pool fields-recovery" $
+        assertEqual "sum recovery"
+        9
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) CollectedRecoveries)
+      ,testCase "Sum on pool fields-loss" $
+        assertEqual "sum loss"
+        12
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) NewLosses)
+      ,testCase "Sum on pool fields-cash" $
+        assertEqual "sum cash"
+        404.0
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) CollectedCash)
+      ,testCase "Sum on pool fields-prepay penalty" $
+        assertEqual "sum prepayment penalty"
+        65
+        (CF.sumPoolFlow (CF.CashFlowFrame dummySt cflow1) CollectedPrepaymentPenalty)
+      ,testCase "Patch Cumulative 0" $
+        assertEqual "patch cum stats"
+        [CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 1 2 3 4 0.0 Nothing (Just 10) (Just (20,20,1,2,3,4))
+        ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 30 20 30 1 2 3 4 0.0 Nothing (Just 15) (Just (50,50,2,4,6,8))
+        ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 40 30 40 1 2 3 4 0.0 Nothing (Just 20) (Just (90,90,3,6,9,12))
+        ,CF.MortgageDelinqFlow (L.toDate "20230401") 180 50 40 50 1 2 3 4 0.0 Nothing (Just 30) (Just (140,140,4,8,12,16))
+        ]
+        (CF.patchCumulative (0,0,0,0,0,0) [] cflow2)
+    ]
+
+testClawIntTest = 
+  let 
+    cflow =[CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 1 2 3 4 0.0 Nothing (Just 10) Nothing
+           ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 30 20 30 1 2 3 4 0.0 Nothing (Just 15) Nothing ]
+  in         
+    testGroup "test on interest claw"   
+    [
+      testCase "claw in first" $
+        assertEqual "AA"
+        [0,0]
+        (CF.mflowInterest <$> CF.clawbackInt 30 cflow)
+      ,testCase "claw in second" $
+        assertEqual "AA"
+        [0,15]
+        (CF.mflowInterest <$> CF.clawbackInt 15 cflow)
+      ,testCase "claw in all" $
+        assertEqual "AA"
+        [5,20]
+        (CF.mflowInterest <$> CF.clawbackInt 5 cflow)
+    ]
+
+testPoolAggTest = 
+  let 
+    trs = [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing (Just (10,0,0,0,0,0))
+          , CF.MortgageFlow (L.toDate "20220301") 70 10 10 0 0 0 0 0 Nothing Nothing (Just (20,0,0,0,0,0)) ]
+    trs1 = [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing (Just (10,0,0,0,0,0))
+          , CF.MortgageFlow (L.toDate "20220401") 70 10 10 0 0 0 0 0 Nothing Nothing (Just (20,0,0,0,0,0)) ]
+    trs2 = [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing (Just (10,0,0,0,0,0))
+          , CF.MortgageFlow (L.toDate "20220401") 70 10 10 0 10 0 0 0 Nothing Nothing (Just (20,0,0,10,0,0)) ]
+          
+    cf = CF.CashFlowFrame dummySt trs    
+    cf1 = CF.CashFlowFrame dummySt trs1
+    cf2 = CF.CashFlowFrame dummySt trs2
+    
+  in 
+    testGroup "test on combine cashflow with stats"   
+    [
+      testCase "combineCF one extra row" $
+        assertEqual "cum stats should patch at last"
+        (CF.CashFlowFrame dummySt
+          [
+            CF.MortgageFlow (L.toDate "20220101") 200 20 20 0 0 0 0 0 Nothing Nothing (Just (20,0,0,0,0,0))
+            ,CF.MortgageFlow (L.toDate "20220301") 190 10 10 0 0 0 0 0 Nothing Nothing (Just (30,0,0,0,0,0))
+            ,CF.MortgageFlow (L.toDate "20220401") 180 10 10 0 0 0 0 0 Nothing Nothing (Just (40,0,0,0,0,0))
+          ]
+          )
+        (fst (Pool.aggPool Nothing [(cf,Map.empty),(cf1,Map.empty)]))
+      ,testCase "pool agg with init default=100" $
+        assertEqual "cum stats with default=100,no default on cfs"
+        (Map.fromList [(HistoryDefaults,100)])
+        (snd (Pool.aggPool (Just (Map.fromList [(HistoryDefaults,100)])) 
+                            [(cf,Map.empty),(cf1,Map.empty)]
+                            ))
+      ,testCase "pool agg with init default=100 and projected cf default" $
+        assertEqual "cum stats with default=100, projected default on cfs"
+        (Map.fromList [(HistoryDefaults,200)])
+        (snd (Pool.aggPool (Just (Map.fromList [(HistoryDefaults,100)])) 
+                            [(cf, (Map.fromList [(HistoryDefaults,100)])),(cf1,Map.empty)]
+                            ))
+      ,testCase "pool agg with init default=100 and projected cf default2" $
+        assertEqual "cum stats with default=100, projected default on cfs"
+        (Map.fromList [(HistoryDefaults,200)])
+        (snd (Pool.aggPool (Just (Map.fromList [(HistoryDefaults,100)])) 
+                            [(cf, (Map.fromList [(HistoryDefaults,100)])),(cf2, Map.empty)]
+                            ))                            
+    ]
diff --git a/test/UT/CeTest.hs b/test/UT/CeTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/CeTest.hs
@@ -0,0 +1,69 @@
+module UT.CeTest(liqTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import Lib
+import Util
+import Stmt
+import Data.Ratio
+import qualified Data.DList as DL
+import Types
+import CreditEnhancement
+import qualified InterestRate as IR
+
+
+
+liqTest = testGroup "Pricing Tests"
+  [
+    let
+        liqStmt1 = [
+            -- SupportTxn (toDate "20220101") 100,
+            ]
+        liq0 = LiqFacility "Liq0" (FixSupport 1000) 100 (Just 500) Nothing Nothing Nothing 
+                (Just 0.03) (Just 0.08) Nothing 0 0 (toDate "20220101")
+                Nothing Nothing
+    in
+      testCase "First Accure" $
+        assertEqual "First Accure"  
+          (Just (Statement (DL.fromList [SupportTxn (toDate "20220101") (Just 500) 100 0 0 0 Empty
+                            ,SupportTxn (toDate "20220201") (Just 500) 100 0.25 3.39 0 (LiquidationSupportInt 0.25 3.39)])))
+          (liqStmt (accrueLiqProvider (toDate "20220201") liq0 ))
+    ,let
+        liqStmt1 = DL.fromList [
+            SupportTxn (toDate "20220101") (Just 500) 100 0 0 0 Empty
+            ,SupportTxn (toDate "20220201") (Just 800) 100 0.25 3.39 0 (LiquidationSupportInt 0.25 3.39)
+            ]
+        liq1 = LiqFacility "Liq1" (FixSupport 1000) 100 (Just 800) Nothing (Just (IR.Fix DC_ACT_365 0.03)) (Just (IR.Fix DC_ACT_365 0.08))  
+                (Just 0.03) (Just 0.08) Nothing 0.25 3.39 (toDate "20220201")
+                Nothing (Just (Statement liqStmt1))
+
+    in
+      testCase "Accure on unused balance" $
+        assertEqual "with one history txn"  
+          (Just (Statement (DL.fromList [SupportTxn (toDate "20220101") (Just 500) 100 0 0 0 Empty
+                            ,SupportTxn (toDate "20220201") (Just 800) 100 0.25 3.39 0 (LiquidationSupportInt 0.25 3.39)
+                            ,SupportTxn (toDate "20220301") (Just 800) 100 0.48 8.29 0 (LiquidationSupportInt 0.23 4.9)])))
+          (liqStmt (accrueLiqProvider (toDate "20220301") liq1 )) 
+    ,let
+        liqStmt1 = DL.fromList [
+            SupportTxn (toDate "20220101") (Just 500) 100 0 0 0 Empty
+            ,SupportTxn (toDate "20220201") (Just 800) 100 0.25 3.39 0 (LiquidationSupportInt 0.25 3.39)
+            ,SupportTxn (toDate "20220301") (Just 1000) 100 0.48 8.29 0 (LiquidationSupportInt 0.23 4.9)
+            ]
+        liq1 = LiqFacility "Liq2" (FixSupport 1000) 100 (Just 1000) Nothing (Just (IR.Fix DC_ACT_365 0.03)) (Just (IR.Fix DC_ACT_365 0.08))  
+                (Just 0.03) (Just 0.08) Nothing 0.25 3.39 (toDate "20220101")
+                Nothing (Just (Statement liqStmt1))
+
+    in
+      testCase "Accure on unused balance " $
+        assertEqual "with multiple history txn"  
+          (Just (Statement (DL.fromList [SupportTxn (toDate "20220101") (Just 500) 100 0 0 0 Empty
+                            ,SupportTxn (toDate "20220201") (Just 800) 100 0.25 3.39 0 (LiquidationSupportInt 0.25 3.39)
+                            ,SupportTxn (toDate "20220301") (Just 1000) 100 0.48 8.29 0 (LiquidationSupportInt 0.23 4.9)
+                            ,SupportTxn (toDate "20220401") (Just 1000) 100 0.99 18.49 0 (LiquidationSupportInt 0.74 15.10)
+                            ])))
+          (liqStmt (accrueLiqProvider (toDate "20220401") liq1 ))    
+  ]
diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/DealTest.hs
@@ -0,0 +1,389 @@
+module UT.DealTest(td2,queryTests,triggerTests,dateTests,liqProviderTest,poolFlowTest)
+
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Deal
+import Deal.DealQuery (queryCompound)
+
+import qualified Accounts as A
+import qualified Stmt as Stmt
+import qualified Pool as P
+import qualified Asset as Ast
+import qualified AssetClass.Mortgage as ACM
+import qualified AssetClass.AssetBase as AB
+import qualified Expense as F
+import qualified Deal.DealBase as D
+import qualified Liability as L
+import qualified Waterfall as W
+import qualified Cashflow as CF
+import qualified Assumptions as AP
+import qualified Call as C
+import InterestRate
+import qualified CreditEnhancement as CE
+import qualified Triggers as Trg
+import Lib
+import Types
+
+import Control.Lens hiding (Index,Empty)
+import Control.Lens.TH
+import Data.Maybe
+import Data.Either
+
+import qualified Data.Map as Map
+import qualified Data.Time as T
+import qualified Data.Set as S
+import qualified Data.DList as DL
+
+import Debug.Trace
+debug = flip Debug.Trace.trace
+
+dummySt = (0,toDate "19000101",Nothing)
+
+
+emptyRunAssump = AP.NonPerfAssumption Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing 
+
+
+td2 = D.TestDeal {
+  D.name = "test deal1"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = (Map.fromList
+  [("General", (A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing
+  })),
+   ("Reserve", (A.Account { A.accName="Reserve" ,A.accBalance=0.0 ,A.accType=Just (A.FixReserve 500), A.accInterest=Nothing ,A.accStmt=Nothing
+  }))
+  ])
+  ,D.fees = (Map.fromList [("Service-Fee"
+                         ,F.Fee{F.feeName="service-fee"
+                                ,F.feeType = F.FixFee 10
+                                ,F.feeStart = (T.fromGregorian 2022 1 1)
+                                ,F.feeDue = 100
+                                ,F.feeDueDate = Nothing
+                                ,F.feeArrears = 0
+                                ,F.feeLastPaidDay = Nothing
+                                ,F.feeStmt = Nothing})])
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndDuePrin=0.0
+                             ,L.bndDueInt=0.0
+                             ,L.bndDueIntOverInt=0.0
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndStmt=Nothing})
+                             ,("B"
+                               ,L.Bond{
+                                L.bndName="B"
+                               ,L.bndType=L.Equity
+                               ,L.bndOriginInfo= L.OriginalInfo{
+                                                  L.originBalance=3000
+                                                  ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                  ,L.originRate= 0.08
+                                                  ,L.maturityDate = Nothing}
+                               ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                               ,L.bndBalance=500
+                               ,L.bndRate=0.08
+                               ,L.bndDuePrin=0.0
+                               ,L.bndDueInt=0.0
+                               ,L.bndDueIntDate=Nothing
+                               ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndStmt=Nothing})
+                         ]
+           )
+  ,D.pool = D.MultiPool $
+               Map.fromList $ 
+                   [( PoolConsol,
+                      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}
+                                         4000
+                                         0.085
+                                         60
+                                         Nothing
+                                         AB.Current
+                                ,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}
+                                   200
+                                   0.085
+                                   60
+                                   Nothing
+                                   (AB.Defaulted Nothing)
+                                 ]
+                 ,P.futureCf=Nothing
+                 ,P.asOfDate = T.fromGregorian 2022 1 1
+                 ,P.issuanceStat = Just $ Map.fromList [(RuntimeCurrentPoolBalance, 70)]}
+                )]
+   ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                  (W.PayFee Nothing "General" ["Service-Fee"] Nothing)
+                                 ,(W.PayInt Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["A"] Nothing)
+   ])]
+ ,D.collects = [W.Collect Nothing W.CollectedInterest "General"
+             ,W.Collect Nothing W.CollectedPrincipal "General"]
+ ,D.custom = Nothing
+ ,D.liqProvider = Just $ Map.fromList $
+                    [("Liq1",CE.LiqFacility 
+                                "" 
+                                (CE.FixSupport 100)
+                                50
+                                (Just 100)
+                                Nothing
+                                Nothing
+                                Nothing
+                                Nothing
+                                Nothing
+                                Nothing 
+                                0
+                                0
+                                (toDate "20220201")
+                                Nothing
+                                (Just (Stmt.Statement (DL.fromList [SupportTxn (toDate "20220215") (Just 110) 10 40 0 0 Empty 
+                                                    ,SupportTxn (toDate "20220315") (Just 100) 10 50 0 0 Empty]))))]
+ ,D.triggers = Just $
+                Map.fromList $
+                  [(BeginDistributionWF,
+                    Map.fromList [ ("revolving trigger",Trg.Trigger{Trg.trgCondition = IfDate G (toDate "20220501")
+                                                                    ,Trg.trgEffects = Trg.DealStatusTo Revolving
+                                                                    ,Trg.trgStatus = False 
+                                                                    ,Trg.trgCurable = False })]
+                                                                    )]
+ ,D.ledgers = Nothing
+ ,D.stats = (Map.empty,Map.empty,Map.empty,Map.empty)
+}
+
+baseDeal = D.TestDeal {
+  D.name = "base deal"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.stats = (Map.empty,Map.empty,Map.empty,Map.empty)
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = Map.fromList [("General", A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing})]
+  ,D.fees = Map.empty 
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndStepUp=Nothing
+                             ,L.bndDuePrin=0.0
+                             ,L.bndDueInt=0.0
+                             ,L.bndDueIntOverInt=0.0
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndStmt=Nothing})
+                             ,("B"
+                               ,L.Bond{
+                                L.bndName="B"
+                               ,L.bndType=L.Equity
+                               ,L.bndOriginInfo= L.OriginalInfo{
+                                                  L.originBalance=3000
+                                                  ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                  ,L.originRate= 0.08
+                                                  ,L.maturityDate = Nothing}
+                               ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                               ,L.bndBalance=500
+                               ,L.bndRate=0.08
+                               ,L.bndStepUp=Nothing
+                               ,L.bndDuePrin=0.0
+                               ,L.bndDueInt=0.0
+                               ,L.bndDueIntOverInt=0.0
+                               ,L.bndDueIntDate=Nothing
+                               ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndStmt=Nothing})
+                         ]
+           )
+  ,D.pool = D.MultiPool $
+               Map.fromList $ 
+                   [( PoolConsol,
+                      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.obligor = Nothing
+                                           ,AB.prepaymentPenalty = Nothing}
+                                         4000
+                                         0.085
+                                         60
+                                         Nothing
+                                         AB.Current]
+                 ,P.futureCf= Nothing
+                 ,P.extendPeriods = Nothing
+                 ,P.asOfDate = T.fromGregorian 2022 1 1
+                 ,P.issuanceStat = Just $ Map.fromList [(RuntimeCurrentPoolBalance, 70),(IssuanceBalance, 4000)]})]
+   ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                 (W.PayInt Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["B"] Nothing)
+   ])]
+ ,D.collects = [W.Collect Nothing W.CollectedCash "General"]
+ ,D.custom = Nothing
+ ,D.liqProvider = Nothing 
+ ,D.triggers = Nothing 
+ ,D.ledgers = Nothing
+ ,D.rateCap = Nothing
+}
+
+poolFlowTest = 
+   let 
+     (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,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" 
+      (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"
+      (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"
+       (Just (BondTxn (toDate "20240201") 0.00 0.00 30.56 0.080000 30.56 0.00 0.00 (Just 0.0) (PayPrin ["A"])))
+       $ (\s -> last (DL.toList (view Stmt.statementTxns s))) <$> (L.bndStmt $ (bndMap Map.! "A"))
+    ]
+
+
+queryTests =  testGroup "deal stat query Tests"
+  [
+    let
+     currentDefBal = queryCompound td2 epocDate CurrentPoolDefaultedBalance
+    in
+     testCase "query current assets in defaulted status" $
+     assertEqual "should be 200" (Right 200) currentDefBal
+  ]
+
+triggerTests = testGroup "Trigger Tests"
+  [ let 
+      setup = 0 
+      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 
+                     ,CF.MortgageDelinqFlow (toDate "20220501") 500 100 20 0 0 0 0 0 0.08 Nothing Nothing Nothing
+                     ,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") ""
+             ,PoolCollection (toDate "20220301")""
+             ,RunWaterfall  (toDate "20220325") ""
+             ,PoolCollection (toDate "20220401")""
+             ,RunWaterfall  (toDate "20220425") ""
+             ,PoolCollection (toDate "20220501")""
+             ,RunWaterfall  (toDate "20220525") ""
+             ,PoolCollection (toDate "20220601")""
+             ,RunWaterfall  (toDate "20220625") ""
+             ,PoolCollection (toDate "20220701")""
+             ,RunWaterfall  (toDate "20220725") ""  ]
+      (fdeal,_,_) = case run td2 poolflowM (Just ads) Nothing Nothing Nothing DL.empty of 
+                    Left _ -> error ""
+                    Right x -> x
+    in 
+      testCase "deal becomes revolving" $
+      assertEqual "revoving" 
+        Revolving 
+        (D.status fdeal)
+  ]
+
+dateTests = 
+  let 
+   a = PreClosingDates
+        (toDate "20220601") 
+        (toDate "20220610") 
+        Nothing
+        (toDate "20220901") 
+        (toDate "20220630",MonthEnd)
+        (toDate "20220715",DayOfMonth 10)
+  in 
+   testGroup "Deal Tests" 
+   [ testCase "Dates pattern" $
+     assertEqual  ""
+    (Right $ 
+      ((toDate "20220601"), (toDate "20220610"),(toDate "20220715")
+        ,[PoolCollection (toDate "20220630") "",PoolCollection (toDate "20220731") "",PoolCollection (toDate "20220831") ""]
+        ,[RunWaterfall (toDate "20220715") "",RunWaterfall (toDate "20220810") ""]
+        ,(toDate "20220901")
+        ,[]))
+     (populateDealDates a Amortizing)
+   ]
+  
+liqProviderTest = 
+  let 
+    liq1 = CE.LiqFacility "" 
+                       (CE.FixSupport 100)
+                       90
+                       (Just 100)
+                       (Just CE.IncludeDueInt)
+                       Nothing -- rate type
+                       Nothing -- premium rate type
+                       
+                       Nothing -- rate
+                       Nothing -- premium reate
+                       (Just (toDate "20220201"))
+                       0
+                       0
+                       (toDate "20220301")
+                       Nothing
+                       (Just (Stmt.Statement 
+                               (DL.fromList ([SupportTxn (toDate "20220215") (Just 110) 40 40 0 0 Empty
+                               ,SupportTxn (toDate "20220315") (Just 100) 50 90 0 0 Empty
+                               ]))))
+  in 
+    testGroup "Liq provider test" 
+      [testCase "Liq Provider Int test" $
+          assertEqual ""
+           (Just 100)
+           (CE.liqCredit $ CE.accrueLiqProvider (toDate "20221101") liq1)
+      ]
diff --git a/test/UT/DealTest2.hs b/test/UT/DealTest2.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/DealTest2.hs
@@ -0,0 +1,235 @@
+module UT.DealTest2 (td,queryTests)
+
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Deal
+
+import Deal.DealQuery (queryCompound)
+import qualified Accounts as A
+import qualified Stmt as S
+import qualified Pool as P
+import qualified Asset as Ast
+import qualified AssetClass.Mortgage as ACM
+import qualified AssetClass.AssetBase as AB
+import qualified Expense as F
+import qualified Deal.DealBase as D
+import qualified Liability as L
+import qualified Waterfall as W
+import qualified Cashflow as CF
+import qualified Assumptions as AP
+import qualified Call as C
+import InterestRate
+import qualified CreditEnhancement as CE
+import qualified Triggers as Trg
+import Lib
+import Types
+
+import qualified Data.Map as Map
+import qualified Data.Time as T
+import qualified Data.Set as S
+import Types (PoolId(PoolConsol))
+
+dummySt = (0,toDate "19000101",Nothing)
+
+td = D.TestDeal {
+  D.name = "test deal"
+  ,D.status = Amortizing
+  ,D.rateSwap = Nothing
+  ,D.currencySwap = Nothing
+  ,D.dates = CurrentDates (toDate "20220101",toDate "20220101") Nothing (toDate "20300101")
+                (toDate "20220201" , MonthFirst) (toDate "20220225" , MonthFirst)
+  ,D.accounts = Map.fromList
+                [("General", A.Account { A.accName="General" ,A.accBalance=1000.0 ,A.accType=Nothing, A.accInterest=Nothing ,A.accStmt=Nothing })]
+  ,D.fees = (Map.fromList [("Service-Fee"
+                         ,F.Fee{F.feeName="service-fee"
+                                ,F.feeType = F.FixFee 10
+                                ,F.feeStart = (T.fromGregorian 2022 1 1)
+                                ,F.feeDue = 100
+                                ,F.feeDueDate = Nothing
+                                ,F.feeArrears = 0
+                                ,F.feeLastPaidDay = Nothing
+                                ,F.feeStmt = Nothing})])
+  ,D.bonds = (Map.fromList [("A"
+                             ,L.Bond{
+                              L.bndName="A"
+                             ,L.bndType=L.Sequential
+                             ,L.bndOriginInfo= L.OriginalInfo{
+                                                L.originBalance=3000
+                                                ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                ,L.originRate= 0.08
+                                                ,L.maturityDate = Nothing}
+                             ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                             ,L.bndBalance=3000
+                             ,L.bndRate=0.08
+                             ,L.bndDuePrin=0.0
+                             ,L.bndDueInt=0.0
+                             ,L.bndDueIntOverInt=0.0
+                             ,L.bndDueIntDate=Nothing
+                             ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                             ,L.bndStmt=Nothing})
+                             ,("B"
+                               ,L.Bond{
+                                L.bndName="B"
+                               ,L.bndType=L.Equity
+                               ,L.bndOriginInfo= L.OriginalInfo{
+                                                  L.originBalance=3000
+                                                  ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                  ,L.originRate= 0.08
+                                                  ,L.maturityDate = Nothing}
+                               ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                               ,L.bndBalance=500
+                               ,L.bndRate=0.08
+                               ,L.bndDuePrin=0.0
+                               ,L.bndDueInt=0.0
+                               ,L.bndDueIntDate=Nothing
+                               ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndStmt=Nothing})
+                         ]
+           )
+  ,D.pool = D.MultiPool $ 
+              Map.fromList [(PoolConsol,
+                      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}
+                                         4000
+                                         0.085
+                                         60
+                                         Nothing
+                                         AB.Current
+                                ,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}
+                                   200
+                                   0.085
+                                   60
+                                   Nothing
+                                   (AB.Defaulted Nothing)
+                                 ]
+                 ,P.futureCf=Nothing
+                 ,P.asOfDate = T.fromGregorian 2022 1 1
+                 ,P.issuanceStat = Nothing}
+                )]
+   ,D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                  (W.PayFee Nothing "General" ["Service-Fee"] Nothing)
+                                 ,(W.PayInt Nothing "General" ["A"] Nothing)
+                                 ,(W.PayPrin Nothing "General" ["A"] Nothing)
+   ])]
+ ,D.collects = [W.Collect Nothing W.CollectedCash "General"]
+ ,D.custom = Nothing
+ ,D.liqProvider = Nothing
+ ,D.triggers = Nothing
+ ,D.ledgers = Nothing
+}
+
+bondGroups = Map.fromList [("A"
+                             ,L.BondGroup (Map.fromList 
+                               [
+                                ("A-1",L.Bond{
+                                        L.bndName="A-1"
+                                        ,L.bndType=L.Sequential
+                                        ,L.bndOriginInfo= L.OriginalInfo{
+                                                            L.originBalance=3000
+                                                            ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                            ,L.originRate= 0.08
+                                                            ,L.maturityDate = Nothing}
+                                        ,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
+                                        ,L.bndDueIntDate=Nothing
+                                        ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                                        ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                                        ,L.bndStmt=Nothing}),
+                                ("A-2",L.Bond{
+                                        L.bndName="A-2"
+                                        ,L.bndType=L.Sequential
+                                        ,L.bndOriginInfo= L.OriginalInfo{
+                                                            L.originBalance=2000
+                                                            ,L.originDate= (T.fromGregorian 2022 1 1)
+                                                            ,L.originRate= 0.08
+                                                            ,L.maturityDate = Nothing}
+                                        ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                                        ,L.bndBalance=1000
+                                        ,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)
+                                        ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                                        ,L.bndStmt=Nothing})
+                                 ]            
+                                ) Nothing)
+                             ,("B"
+                               ,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)
+                                                  ,L.originRate= 0.08
+                                                  ,L.maturityDate = Nothing}
+                               ,L.bndInterestInfo= L.Fix 0.08 DC_ACT_365F
+                               ,L.bndBalance=500
+                               ,L.bndRate=0.08
+                               ,L.bndDuePrin=0.0
+                               ,L.bndDueInt=0.0
+                               ,L.bndDueIntDate=Nothing
+                               ,L.bndLastIntPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndLastPrinPay = Just (T.fromGregorian 2022 1 1)
+                               ,L.bndStmt=Nothing})
+                            ]
+
+tdBondGroup = td { D.bonds = bondGroups,
+                   D.waterfall = Map.fromList [(W.DistributionDay Amortizing, [
+                                  W.PayFee Nothing "General" ["Service-Fee"] Nothing
+                                 ,W.AccrueAndPayInt Nothing "General" ["A"] Nothing
+                                 ,W.PayPrinGroup Nothing "General" "A" W.ByProRataCurBal Nothing
+                                 ,W.PayPrin Nothing "General" ["B"] Nothing
+                ])]
+   }
+
+queryTests =  testGroup "Deal Group Test"
+  [
+    let
+     currBndGrpBal = queryCompound tdBondGroup epocDate (CurrentBondBalanceOf ["A"])
+    in
+     testCase "group bond balance" $
+     assertEqual "should be 2500" (Right 2500) currBndGrpBal
+    ,let 
+        bndsFound = D.viewDealAllBonds tdBondGroup
+     in 
+        testCase "view viewDealAllBonds " $
+        assertEqual "should be 3" 3 (length bndsFound)
+    ,let 
+        totalBndBal = queryCompound tdBondGroup epocDate CurrentBondBalance 
+    in 
+        testCase "total bond balance" $
+        assertEqual "should be 3000" (Right 3000) totalBndBal
+    ,let
+        originBndbal = queryCompound tdBondGroup epocDate (OriginalBondBalanceOf ["A"])
+    in
+        testCase "original bond balance" $
+        assertEqual "should be 5000" (Right 5000) originBndbal
+  ]
diff --git a/test/UT/ExpTest.hs b/test/UT/ExpTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/ExpTest.hs
@@ -0,0 +1,75 @@
+module UT.ExpTest(expTests)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import qualified Lib as L
+import qualified Asset as P
+import qualified Deal as D
+import qualified Deal.DealAction as DA
+import qualified UT.DealTest as DT
+import Expense
+import Types
+import qualified Cashflow as CF
+
+import Debug.Trace
+debug = flip trace
+
+
+expTests =  testGroup "Expense Tests"
+  [
+    let
+     f1 = Fee "FeeName1" (RecurFee MonthFirst 50) (L.toDate "20220101") 0 Nothing 0 Nothing Nothing
+     f2 = Fee "FeeNameAccum" (RecurFee MonthFirst 50) (L.toDate "20220101") 60 (Just (L.toDate "20220310")) 0 Nothing Nothing
+     _calcDate = (L.toDate "20220310")
+     _calcDate2 = (L.toDate "20220115")
+     _calcDate3 = (L.toDate "20220415")
+     feesCalc = sequenceA [(DA.calcDueFee DT.td2 _calcDate f1) ,(DA.calcDueFee DT.td2 _calcDate2 f1) ,(DA.calcDueFee DT.td2 _calcDate3 f2) ,(DA.calcDueFee DT.td2 _calcDate3 f1)]
+    in
+      testCase "calc on diff same period for recur fee" $
+      assertEqual
+        "test date"
+        (Right [100.0, 0.0, 110.0, 150.0])
+        ((feeDue <$>) <$> feesCalc)
+    ,
+    let
+     tsPoints = [(L.TsPoint (L.toDate "20220101") 10.0)
+                 ,(L.TsPoint (L.toDate "20220301") 15.0)
+                 ,(L.TsPoint (L.toDate "20220601") 20.0)]
+     f1 = Fee "FeeName1" (FeeFlow (L.BalanceCurve tsPoints)) (L.toDate "20210101") 0 Nothing 0 Nothing Nothing
+     _calcDate = (L.toDate "20220321")
+     _calcDate2 = (L.toDate "20220621")
+     _calcDate3 = (L.toDate "20211221")
+     f1_ = Fee "FeeName1" (FeeFlow (L.BalanceCurve [(L.TsPoint (L.toDate "20220601") 20.0)])) (L.toDate "20210101") 25 (Just (L.toDate "20220321")) 0 Nothing Nothing
+     f2_ = f1 {feeDue = 45.0, feeDueDate = Just _calcDate2, feeType = FeeFlow (L.BalanceCurve [])}
+     f3_ = f1 {feeDue = 0, feeDueDate = Just _calcDate3}
+
+     f1WithDue = Fee "FeeName1" (FeeFlow (L.BalanceCurve tsPoints)) (L.toDate "20210101") 3 Nothing 0 Nothing Nothing
+     _f1WithDue = f1WithDue {feeType= FeeFlow (L.BalanceCurve [(L.TsPoint (L.toDate "20220601") 20.0)]), feeDue = 28, feeDueDate = Just _calcDate}
+     feesCalc = sequenceA [DA.calcDueFee DT.td2 _calcDate f1
+                          ,DA.calcDueFee DT.td2 _calcDate2 f1
+                          ,DA.calcDueFee DT.td2 _calcDate3 f1
+                          ,DA.calcDueFee DT.td2 _calcDate f1WithDue ]
+    in
+      testCase "test on Custom Fee Type" $
+      assertEqual "calc Due Fee" (Right [f1_ , f2_ , f3_ , _f1WithDue]) feesCalc
+
+  ]
+
+--cnVatFeeTest = 
+--  let 
+--    vatFeeInt = Fee "VatFee" 
+--                  (PctFee (PoolCollectionIncome CollectedInterest) 0.0325) 
+--                  (L.toDate "20220101") 0 Nothing 0 Nothing Nothing
+--    poolFlows = CashFlowFrame $ [MortgageFlow (toDate "20220101") 100 20 15 0 0 0 0 0.01
+--                                 ,MortgageFlow (toDate "20220101") 100 20 15 0 0 0 0 0.01
+--                                 ]
+--  in 
+--    testGroup "China VAT fee test" $
+--    [
+--
+--
+--    ]
+   
diff --git a/test/UT/InterestRateTest.hs b/test/UT/InterestRateTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/InterestRateTest.hs
@@ -0,0 +1,68 @@
+module UT.InterestRateTest(armResetTests,interestRoundingTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import InterestRate
+import Types
+import Lib
+import Util
+
+import Debug.Trace
+debug = flip trace
+
+resetDates = toDates ["20230301","20230401","20230501"] 
+rt = Floater DC_ACT_365F LPR5Y 0.01 0.03 QuarterEnd Nothing Nothing Nothing
+rc = IRateCurve [TsPoint (toDate "20230301") 0.01
+                ,TsPoint (toDate "20230401") 0.02
+                ,TsPoint (toDate "20230501") 0.03]
+
+rc2 = IRateCurve [TsPoint (toDate "20230301") 0.07
+                ,TsPoint (toDate "20230401") 0.02
+                ,TsPoint (toDate "20230501") 0.03]
+
+rc3 = IRateCurve [TsPoint (toDate "20230301") 0.01
+                ,TsPoint (toDate "20230401") 0.08
+                ,TsPoint (toDate "20230501") 0.03]
+ 
+arm = ARM 3 (Just 0.015) (Just 0.02) (Just 0.09) (Just 0.02)
+armCap = ARM 3 (Just 0.015) (Just 0.02) (Just 0.035) (Just 0.02)
+armFloor = ARM 3 (Just 0.015) (Just 0.02) (Just 0.035) (Just 0.025)
+
+armResetTests =  testGroup "ARM reset curve test"
+  [
+    testCase "no adj rate" $
+     assertEqual "no adj rate"  
+       [0.05,0.02,0.03,0.04] 
+       (runInterestRate arm 0.05 rt resetDates rc)
+    ,testCase "cap at first period" $
+     assertEqual "cap at first period" 
+       [0.05,0.065,0.03,0.04] 
+       (runInterestRate arm 0.05 rt resetDates rc2)
+    ,testCase "cap at second period" $ 
+     assertEqual "Cap at second period" 
+       [0.05,0.02,0.04,0.04] 
+       (runInterestRate arm 0.05 rt resetDates rc3)
+    ,testCase "cap at life cap" $ 
+     assertEqual "Cap at life" 
+       [0.05,0.02,0.035,0.035] 
+       (runInterestRate armCap 0.05 rt resetDates rc3)
+    ,testCase "life floor" $ 
+     assertEqual "life floor" 
+       [0.05,0.025,0.035,0.035] 
+       (runInterestRate armFloor 0.05 rt resetDates rc3)
+  ]
+
+-- resetDates = toDates ["20230301","20230401","20230501"] 
+rt2 = Floater DC_ACT_365F LPR5Y 0.01 0.03 QuarterEnd Nothing Nothing (Just (RoundFloor 0.02))
+
+interestRoundingTest =  testGroup "Interest Rounding"
+  [
+    testCase "rounding by 0.005" $
+     assertEqual "no adj rate"  
+       [0.05,0.02,0.02,0.04] 
+       (runInterestRate arm 0.05 rt2 resetDates rc)
+    
+  ]
diff --git a/test/UT/LibTest.hs b/test/UT/LibTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/LibTest.hs
@@ -0,0 +1,198 @@
+module UT.LibTest(curveTests
+                 --,queryStmtTests
+                 ,datesTests
+                 ,prorataTests
+                 ,tsOperationTests
+                 ,pvTests,seqFunTest,periodCurveTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import Lib
+import Types
+import Util
+import Stmt
+import Data.Ratio
+
+curveTests =
+    let
+     _ts = (FloatCurve [TsPoint (toDate "20210101") 0.01
+                         ,TsPoint (toDate "20230101") 0.02])
+     _r1 = getValByDate _ts Exc (toDate "20201231")
+     _r2 = getValByDate _ts Exc (toDate "20210201")
+     _r3 = getValByDate _ts Exc (toDate "20230102")
+     _r4 = getValByDate _ts Exc (toDate "20231231")
+
+     _priceTs = (PricingCurve
+                  [TsPoint (toDate "20210101") 0.01
+                  ,TsPoint (toDate "20210110") 0.02])
+    in
+  testGroup "Curve Tests"
+  [
+    testCase "Query interst rate curve by date" $
+      assertEqual
+        "test 4 dates"
+        [_r1,_r2,_r3,_r4] [0, 0.01,0.02,0.02]
+    ,testCase "Pricing Curve Test1" $
+      assertEqual "left"
+        0.01
+        (getValByDate _priceTs Exc (toDate "20201231"))
+    ,testCase "Pricing Curve Test2" $
+      assertEqual "Right"
+        0.02
+        (getValByDate _priceTs Exc (toDate "20210121"))
+    ,testCase "Pricing Curve Test3" $
+      assertEqual "Mid"
+        (13 % 900)
+        (getValByDate _priceTs Exc (toDate "20210105"))
+  ]
+
+periodCurveTest = 
+  let
+    _ts = CurrentVal [PerPoint 0 100, PerPoint 1 200, PerPoint 2 300, PerPoint 4 400]
+    _rs1 = getValFromPerCurve _ts Future Inc <$> [0,1,2,3,4,5]
+    _rs2 = getValFromPerCurve _ts Future Exc <$> [0,1,2,3,4,5]
+    _rs3 = getValFromPerCurve _ts Past Inc <$> [0,1,2,3,4,5]
+    _rs4 = getValFromPerCurve _ts Past Exc <$> [0,1,2,3,4,5]
+    _ts1 = WithTrailVal [PerPoint 0 100, PerPoint 1 200, PerPoint 2 300]
+    _r3 = getValFromPerCurve _ts1 Future Inc 4
+    _r4 = getValFromPerCurve _ts1 Future Exc 2
+  in
+  testGroup "Period Curve Tests"
+  [
+    testCase "Query period curve by period:Future" $
+      assertEqual
+        "test 5 period:Future:Inc"
+        [Just 100, Just 200, Just 300, Just 400, Just 400, Nothing]
+        _rs1 
+    ,testCase "Query period curve by period:Future" $
+      assertEqual
+        "test 5 period:Future:Exc"
+        [Just 200, Just 300, Just 400, Just 400, Nothing, Nothing]
+        _rs2
+    ,testCase "Query period curve by period:Past " $
+      assertEqual
+        "test 5 period:Past:Inc"
+        [Just 100, Just 200, Just 300, Just 300, Just 400, Just 400]
+        _rs3
+    ,testCase "Query period curve by period:Past " $
+      assertEqual
+        "test 5 period:Past:Exc"
+        [Nothing, Just 100, Just 200, Just 300, Just 300, Just 400]
+        _rs4
+  ]
+
+--queryStmtTests = testGroup "queryStmtTest"
+--  [
+--   let
+--    stmt1 = Statement [
+--             AccTxn (toDate "20200101") 100 (-12) Empty
+--             ,AccTxn (toDate "20200101") 100 10 Empty
+--             ,AccTxn (toDate "20200101") 100 (-20) Empty]
+--    r1 = queryStmtAmt (Just stmt1) Empty
+--    r2 = queryStmtAmt (Just stmt1) Empty
+--    r3 = queryStmtAmt Nothing Empty
+--   in
+--    testCase "Query With Plain String" $
+--    assertEqual "Simple String Comment"
+--             [r1,r2,r3]
+--             [12,32,0]
+--  ]
+
+datesTests = testGroup "date related "
+  [
+   let
+      d1 = genDates (toDate "20220801") Monthly 1
+   in
+     testCase "1 Month" $
+     assertEqual "1 Month" [toDate "20220901"] d1
+   ,
+   let
+      d2 = genDates (toDate "20220801") Monthly 0
+   in
+     testCase "zero extra" $
+     assertEqual "1 Month" [] d2
+
+  ]
+
+prorataTests = testGroup "prorata Test"
+  [
+    let 
+      bals1 = [100,200,300]
+    in 
+      testCase "3 bals" $
+        assertEqual ""
+          [10,20,30]
+          (prorataFactors bals1 60)
+    ,
+    let 
+      bals2 = [100,200,0]
+    in 
+      testCase "2 bals" $
+        assertEqual ""
+          [20,40,0]
+          (prorataFactors bals2 60)
+  ]
+
+tsOperationTests =
+  let 
+   bcurve = BalanceCurve [TsPoint (toDate "20221101") 100
+                         ,TsPoint (toDate "20221201") 50]
+  in
+   testGroup "operation on ts"
+   [
+     testCase "split ts by date" $ 
+       assertEqual " split in middle "
+       (BalanceCurve [TsPoint (toDate "20221101") 100]
+       ,BalanceCurve [TsPoint (toDate "20221201") 50]) $
+       splitTsByDate bcurve (toDate "20221110")
+    ,testCase "split ts by date on left 1" $ 
+       assertEqual " split on out of scope"
+       (BalanceCurve []
+       ,BalanceCurve [TsPoint (toDate "20221101") 100,TsPoint (toDate "20221201") 50]) $
+       splitTsByDate bcurve (toDate "20221001")
+    ,testCase "split ts by date on right 2" $ 
+       assertEqual " split on out of scope"  
+       (BalanceCurve [TsPoint (toDate "20221101") 100,TsPoint (toDate "20221201") 50] 
+       ,(BalanceCurve [])) $ 
+       splitTsByDate bcurve (toDate "20221202")
+    ,testCase "split ts by date on left 3" $ 
+       assertEqual " split on out of scope"
+       (BalanceCurve [TsPoint (toDate "20221101") 100]
+       ,BalanceCurve [TsPoint (toDate "20221201") 50]) $
+       splitTsByDate bcurve (toDate "20221101")
+   ]
+
+pvTests = 
+    testGroup "PV test"
+    [testCase "PV 6 months" $
+        assertEqual "6M"
+        1
+        1
+    ,testCase "PV 1 Y" $
+        assertEqual "12M"
+        1
+        1
+    ]
+
+seqFunTest = 
+    let 
+      a =1 
+    in 
+    testGroup "seq fun test"
+    [
+     testCase "clear:even" $
+      assertEqual "Good for first"
+      [100,20,0]
+      (paySeqLiabilitiesAmt 120 [100,20,0])
+    ,testCase "shortfall" $
+      assertEqual "Good for first" 
+      [100,20,0]
+      (paySeqLiabilitiesAmt 120 [100,20,10])
+    ,testCase "over " $
+      assertEqual "Good for first"
+      [100,10,0]
+      (paySeqLiabilitiesAmt 120 [100,10,0])
+    ]
diff --git a/test/UT/QueryTest.hs b/test/UT/QueryTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/QueryTest.hs
@@ -0,0 +1,42 @@
+module UT.QueryTest(queryTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import Lib
+import Util
+import Stmt
+import Cashflow
+import Data.Ratio 
+import qualified UT.DealTest as DT
+import Deal
+import Deal.DealBase
+import Asset
+import Types
+
+
+dummySt = (0,Lib.toDate "19000101",Nothing)
+
+
+
+queryTest = 
+  let 
+    a = CashFlowFrame dummySt $ [ MortgageFlow (toDate "20220101") 100 20 15 0 0 0 0 0.01 Nothing Nothing Nothing
+                        , MortgageFlow (toDate "20220201") 100 20 15 0 0 0 0 0.01 Nothing Nothing Nothing
+                        , MortgageFlow (toDate "20220301") 100 20 15 0 0 0 0 0.01 Nothing Nothing Nothing
+                        , MortgageFlow (toDate "20220401") 100 20 15 0 0 0 0 0.01 Nothing Nothing Nothing
+                        ]
+    -- opool = (pool DT.td2)
+    -- t = DT.td2 { pool = (opool { futureCf = Just a }) }                    
+  in 
+    testGroup "" $ 
+      [
+        testCase "Query Interest Collected" $
+          assertEqual "Mid slide"
+            30.0
+            -- (queryDeal t (PoolCollectionHistory CollectedInterest (toDate "20220115") (toDate "20220315") Nothing))            
+            30.0 --TODO
+
+      ]
diff --git a/test/UT/RateHedgeTest.hs b/test/UT/RateHedgeTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/RateHedgeTest.hs
@@ -0,0 +1,41 @@
+module UT.RateHedgeTest(capRateTests)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import Lib
+import Types
+import Util
+import Stmt
+import Deal (accrueRC)
+import Data.Ratio 
+import UT.DealTest (td2)
+import Hedge (RateSwap(..),RateCap(..),RateSwapBase(..),rcNetCash)
+
+capRateTests =
+  let
+    rc = RateCap LIBOR6M (mkRateTs [(Lib.toDate "20240101",0.035)
+                               ,(Lib.toDate "20250101",0.040)])
+                         (Fixed 1000)
+                 (Lib.toDate "20240101") QuarterEnd (Lib.toDate "20270101")
+                 0.03 Nothing 0 Nothing
+    indexAssump = [RateFlat LIBOR6M 0.04]
+    rc1 = accrueRC td2 (Lib.toDate "20241231") indexAssump rc
+  in
+    testGroup "Cap Rate Tests"
+    [
+      testCase "Accure out of scope" $
+        assertEqual "before"
+          (Right rc)
+          (accrueRC td2 (Lib.toDate "20231201") indexAssump rc)
+      ,testCase "Accure out of scope" $
+        assertEqual "after" 
+          (Right rc)
+          (accrueRC td2 (Lib.toDate "20280101") indexAssump rc)
+      ,testCase "Accrue on flat curve" $
+        assertEqual "netCash" 
+          (Right 5.0)
+          (rcNetCash <$> rc1)
+    ]
diff --git a/test/UT/StmtTest.hs b/test/UT/StmtTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/StmtTest.hs
@@ -0,0 +1,145 @@
+module UT.StmtTest(txnTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import Lib
+import Util
+import Stmt
+import Data.Ratio
+import Types
+
+txnTest = 
+    testGroup "Txn test" 
+    [
+       testCase "Weight Average Balance " $ 
+           assertEqual "Weight Average Balacne " 
+           7.44 $
+           weightAvgBalance 
+             (toDate "20221101") 
+             (toDate "20221201")
+             [(AccTxn (toDate "20221115") 100 20 Empty)]
+      ,testCase "Weight Average Balance " $ 
+           assertEqual "Weight Average Balacne "
+           7.26 $
+           weightAvgBalance 
+             (toDate "20221101") 
+             (toDate "20221201")
+             [AccTxn (toDate "20221115") 100 20 Empty
+             ,AccTxn (toDate "20221125") 90 (negate 10) Empty
+             ]
+      ,testCase "Weight Average Balance " $ 
+           assertEqual "Weight Average Balacne by dates"
+           [ 7.26, 5.64 ] $
+           weightAvgBalanceByDates 
+             [toDate "20221101",toDate "20221201",toDate "20221225"]
+             [AccTxn (toDate "20221115") 100 20 Empty
+             ,AccTxn (toDate "20221125") 90 (negate 10) Empty
+             ,AccTxn (toDate "20221215") 80 (negate 10) Empty]
+      , let
+          testTxns = [AccTxn (toDate "20221115") 100 20 Empty
+                      ,AccTxn (toDate "20221125") 90 (negate 10) Empty
+                      ,AccTxn (toDate "20221215") 80 (negate 10) Empty]
+        in
+        testCase "Get Txn As Of" $ 
+           assertEqual "Get Txn Asof 1"
+            Nothing $
+            getTxnAsOf testTxns (toDate "20221101")
+      , let
+          testTxns = [AccTxn (toDate "20221115") 100 20 Empty
+                      ,AccTxn (toDate "20221125") 90 (negate 10) Empty
+                      ,AccTxn (toDate "20221215") 80 (negate 10) Empty]
+        in
+        testCase "Get Txn As Of" $
+           assertEqual "Get Txn Asof 2"
+            [(Just (AccTxn (toDate "20221115") 100 20 Empty)) 
+            , (Just (AccTxn (toDate "20221215") 80 (negate 10) Empty))
+            , (Just (AccTxn (toDate "20221115") 100 20 Empty))
+            ] $
+            [(getTxnAsOf testTxns (toDate "20221115"))
+             ,(getTxnAsOf testTxns (toDate "20221216"))
+             ,(getTxnAsOf testTxns (toDate "20221120"))
+            ]
+      , let 
+          testTxns = [AccTxn (toDate "20221115") 100 20 Empty
+                      ,AccTxn (toDate "20221125") 90 (negate 10) Empty
+                      ,AccTxn (toDate "20221125") 80 (negate 10) Empty
+                      ,AccTxn (toDate "20221215") 80 (negate 10) Empty]
+        in 
+          testCase "Get Txn As Of" $
+            assertEqual "Get Txn Asof on duplicate date" 
+            (Just (AccTxn (toDate "20221125") 80 (negate 10) Empty))
+            (getTxnAsOf testTxns (toDate "20221201"))
+
+      , let 
+          testTxns = [AccTxn (toDate "20221115") 100 20 Empty
+                      ,AccTxn (toDate "20221125") 90 (negate 10) Empty
+                      ,AccTxn (toDate "20221215") 80 (negate 10) Empty]
+        in 
+          testCase "Test View balance as of " $
+            assertEqual "View balance as of 1"
+            [80,100,100,80] $
+            [viewBalanceAsOf (toDate "20221114") testTxns,
+            viewBalanceAsOf (toDate "20221115") testTxns,
+            viewBalanceAsOf (toDate "20221116") testTxns,
+            viewBalanceAsOf (toDate "20221225") testTxns]
+
+      ,testCase "weight Average Balance 0 ' " $ 
+            assertEqual "Weight Average Balacne '"
+            0.27 $
+            weightAvgBalance' (toDate "20221115") (toDate "20221116") 
+              [BondTxn (toDate "20221115") 100 20 10 0.02 30 0 0 Nothing Empty ]
+      ,testCase "weight Average Balance 1" $ 
+            assertEqual "Weight Average Balacne '"
+            8.21 $
+            weightAvgBalance' (toDate "20221115") (toDate "20221215") 
+              [BondTxn (toDate "20221115") 100 20 10 0.02 30 0 0 Nothing Empty
+              ,BondTxn (toDate "20221215") 50 50 10 0.02 30 0 0 Nothing Empty]
+      ,testCase "weight Average Balance 2" $ 
+            assertEqual "Weight Average Balacne '"
+            14.74 $
+            weightAvgBalance' (toDate "20221101") (toDate "20230101") 
+              [BondTxn (toDate "20221115") 100 20 10 0.02 30 0 0 Nothing Empty
+              ,BondTxn (toDate "20221215") 50 50 10 0.02 30 0 0 Nothing Empty]
+      ,testCase "weight Average Balance 3" $ 
+            assertEqual "Weight Average Balacne '"
+            12.03 $
+            weightAvgBalance' (toDate "20221110") (toDate "20230101")
+              [(BondTxn (toDate "20221115") 100 20 10 0.02 30 0 0 Nothing Empty)
+              ,(BondTxn (toDate "20221215") 50 50 10 0.02 30 0 0 Nothing Empty)]
+      ,testCase "weight Average Balance 4" $ 
+            assertEqual "Weight Average Balacne '"
+            8.86 $
+            weightAvgBalance'  (toDate "20220101") (toDate "20220201")
+              [(BondTxn (toDate "20220115") 100 20 10 0.02 30 0 0 Nothing Empty) ]
+      ,testCase " view balance test" $ 
+            assertEqual "View balance test(bond) 1 "
+            110 $
+            viewBalanceAsOf (toDate "20221114") 
+                            [BondTxn (toDate "20221115") 100 20 10 0.02 30 0 0 Nothing Empty]
+      ,testCase " view balance test" $ 
+            assertEqual "View balance test(bond) 2"
+            100 $
+            viewBalanceAsOf (toDate "20221116") 
+                            [BondTxn (toDate "20221115") 100 20 10 0.02 30 0 0 Nothing Empty]
+      ,testCase " view balance test" $ 
+            assertEqual "View balance test(supportTxn)"
+            20 $
+            viewBalanceAsOf (toDate "20221201") 
+                            [SupportTxn (toDate "20221115") (Just 100) 20 0 0 0 Empty
+                            ,SupportTxn (toDate "20221215") (Just 20) 30 0 0 0 Empty
+                            ]
+      ,testCase " view balance test" $ 
+            assertEqual "View balance test( same day txns)"
+            30 $
+            viewBalanceAsOf (toDate "20221201") 
+                            [SupportTxn (toDate "20220915") (Just 100) 20 0 0 0 Empty
+                            ,SupportTxn (toDate "20221015") (Just 90) 10 0 0 0 Empty
+                            ,SupportTxn (toDate "20221015") (Just 80) 30 0 0 0 Empty
+                            ,SupportTxn (toDate "20221215") (Just 70) 30 0 0 0 Empty
+                            ]
+
+    ]
+
diff --git a/test/UT/UtilTest.hs b/test/UT/UtilTest.hs
new file mode 100644
--- /dev/null
+++ b/test/UT/UtilTest.hs
@@ -0,0 +1,647 @@
+module UT.UtilTest(daycountTests1,daycountTests2,daycountTests3,daycountTests4
+                  ,tsTest,ts2Test,ts3Test,dateVectorPatternTest,paddingTest,dateSliceTest
+                  ,capTest,roundingTest,sliceTest,splitTsTest,tableTest,lastOftest,paySeqTest
+                  ,scaleListTest)--,daycountTests3,daycountTests4)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.Time as T
+import qualified Cashflow as CF
+import qualified Liability as L
+import Util
+import DateUtil
+import Lib
+import Types
+import Stmt
+import Data.Fixed
+import qualified Data.DList as DL
+import Data.Ratio ((%))
+
+import Debug.Trace
+debug = flip trace
+
+
+daycountTests1 =  
+  let
+    d1 = T.fromGregorian 2007 12 28
+    d2 = T.fromGregorian 2008 2 28
+  in
+    testGroup "Day Count Tests 1"
+  [
+    testCase "Act/Act" $
+      assertEqual "should be close to 0.1694288494678 " 
+        ((4 % 365) + (58 % 366)) $  
+        yearCountFraction DC_ACT_ACT d1 d2
+    ,testCase "Act/365F" $
+      assertEqual "" 
+        (62 % 365) $ 
+        yearCountFraction DC_ACT_365F d1 d2
+    ,testCase "Act/360" $
+      assertEqual "" 
+        (62 % 360) $ 
+        yearCountFraction DC_ACT_360 d1 d2
+    ,testCase "Act/365A" $
+      assertEqual "" 
+        (62 % 365) $ 
+        yearCountFraction DC_ACT_365A d1 d2
+    ,testCase "Act/365L" $
+      assertEqual "" 
+        (62 % 366) $ 
+        yearCountFraction DC_ACT_365L d1 d2
+    ,testCase "NL/365" $
+      assertEqual "" 
+        (62 % 365) $ 
+        yearCountFraction DC_NL_365 d1 d2
+    ,testCase "30 360 ISDA" $
+      assertEqual "" 
+        (60 % 360) $ 
+        yearCountFraction DC_30_360_ISDA d1 d2
+    ,testCase "30E 360" $
+      assertEqual "" 
+        (60 % 360) $ 
+        yearCountFraction DC_30E_360 d1 d2
+    ,testCase "30Ep 360" $
+      assertEqual "" 
+        (60 % 360) $ 
+        yearCountFraction DC_30Ep_360 d1 d2
+    ,testCase "30 360 German" $
+      assertEqual "" 
+        (60 % 360) $ 
+        yearCountFraction DC_30_360_German d1 d2
+    ,testCase "30 360 US" $
+      assertEqual "" 
+        (60 % 360) $ 
+        yearCountFraction DC_30_360_US d1 d2
+  ]
+
+daycountTests2 =  
+ let
+   d1 = T.fromGregorian 2007 12 28
+   d2 = T.fromGregorian 2008 2 29
+ in
+   testGroup "Day Count Tests 2"
+ [
+   testCase "Act/Act" $
+     assertEqual "" 
+       ((4 % 365) + (59 % 366)) $ 
+       yearCountFraction DC_ACT_ACT d1 d2
+   ,testCase "Act/365F" $
+     assertEqual "" 
+       (63 % 365) $ 
+       yearCountFraction DC_ACT_365F d1 d2
+   ,testCase "Act/360" $
+     assertEqual "" 
+       (63 % 360) $ 
+       yearCountFraction DC_ACT_360 d1 d2
+   ,testCase "Act/365A" $
+     assertEqual "" 
+       (63 % 366) $ 
+       yearCountFraction DC_ACT_365A d1 d2
+   ,testCase "Act/365L" $
+     assertEqual "" 
+       (63 % 366) $ 
+       yearCountFraction DC_ACT_365L d1 d2
+   ,testCase "NL/365" $
+     assertEqual "" 
+       (62 % 365) $ 
+       yearCountFraction DC_NL_365 d1 d2
+   ,testCase "30 360 ISDA" $
+     assertEqual "" 
+       (61 % 360) $ 
+       yearCountFraction DC_30_360_ISDA d1 d2
+   ,testCase "30E 360" $
+     assertEqual "" 
+       (61 % 360) $ 
+       yearCountFraction DC_30E_360 d1 d2
+   ,testCase "30Ep 360" $
+     assertEqual "" 
+       (61 % 360) $ 
+       yearCountFraction DC_30Ep_360 d1 d2
+   ,testCase "30 360 German" $
+     assertEqual "" 
+       (62 % 360) $ 
+       yearCountFraction DC_30_360_German d1 d2
+   ,testCase "30 360 US" $
+     assertEqual "" 
+       (61 % 360) $ 
+       yearCountFraction DC_30_360_US d1 d2
+ ]
+ 
+daycountTests3 =  
+ let
+   d1 = T.fromGregorian 2007 10 31
+   d2 = T.fromGregorian 2008 11 30
+ in
+   testGroup "Day Count Tests 3"
+ [
+   testCase "Act/Act" $
+     assertEqual "should be close to 0.1694288494678 " 
+       ((62 % 365) + (334 % 366)) $ 
+       yearCountFraction DC_ACT_ACT d1 d2
+   ,testCase "Act/365F" $
+     assertEqual "" 
+       (396 % 365) $ 
+       yearCountFraction DC_ACT_365F d1 d2
+   ,testCase "Act/360" $
+     assertEqual "" 
+       (396 % 360) $ 
+       yearCountFraction DC_ACT_360 d1 d2
+   ,testCase "Act/365A" $
+     assertEqual "" 
+       (396 % 366) $ 
+       yearCountFraction DC_ACT_365A d1 d2
+   ,testCase "Act/365L" $
+     assertEqual "" 
+       (396 % 366) $ 
+       yearCountFraction DC_ACT_365L d1 d2
+   ,testCase "NL/365" $
+     assertEqual "" 
+       (395 % 365) $ 
+       yearCountFraction DC_NL_365 d1 d2
+   ,testCase "30 360 ISDA" $
+     assertEqual "" 
+       (390 % 360) $ 
+       yearCountFraction DC_30_360_ISDA d1 d2
+   ,testCase "30E 360" $
+     assertEqual "" 
+       (390 % 360) $ 
+       yearCountFraction DC_30E_360 d1 d2
+   ,testCase "30Ep 360" $
+     assertEqual "" 
+       (390 % 360) $ 
+       yearCountFraction DC_30Ep_360 d1 d2
+   ,testCase "30 360 German" $
+     assertEqual "" 
+       (390 % 360) $ 
+       yearCountFraction DC_30_360_German d1 d2
+   ,testCase "30 360 US" $
+     assertEqual "" 
+       (390 % 360) $ 
+       yearCountFraction DC_30_360_US d1 d2
+ ]
+ 
+daycountTests4 =  
+ let
+   d1 = T.fromGregorian 2008 2 1
+   d2 = T.fromGregorian 2009 5 31
+ in
+   testGroup "Day Count Tests 4"
+ [
+   testCase "Act/Act" $
+     assertEqual "" 
+       ((335 % 366) + (150 % 365)) $ 
+       yearCountFraction DC_ACT_ACT d1 d2
+   ,testCase "Act/365F" $
+     assertEqual "" 
+       (485 % 365) $ 
+       yearCountFraction DC_ACT_365F d1 d2
+   ,testCase "Act/360" $
+     assertEqual "" 
+       (485 % 360) $ 
+       yearCountFraction DC_ACT_360 d1 d2
+   ,testCase "Act/365A" $
+     assertEqual "" 
+       (485 % 366) $ 
+       yearCountFraction DC_ACT_365A d1 d2
+   ,testCase "Act/365L" $
+     assertEqual "" 
+       (485 % 365) $ 
+       yearCountFraction DC_ACT_365L d1 d2
+   ,testCase "NL/365" $
+     assertEqual "" 
+       (484 % 365) $ 
+       yearCountFraction DC_NL_365 d1 d2
+   ,testCase "30 360 ISDA" $
+     assertEqual "" 
+       (480 % 360) $ 
+       yearCountFraction DC_30_360_ISDA d1 d2
+   ,testCase "30E 360" $
+     assertEqual "" 
+       (479 % 360) $ 
+       yearCountFraction DC_30E_360 d1 d2
+   ,testCase "30Ep 360" $
+     assertEqual "" 
+       (480 % 360) $ 
+       yearCountFraction DC_30Ep_360 d1 d2
+   ,testCase "30 360 German" $
+     assertEqual "" 
+       (479 % 360) $ 
+       yearCountFraction DC_30_360_German d1 d2
+   ,testCase "30 360 US" $
+     assertEqual "" 
+       (480 % 360) $ 
+       yearCountFraction DC_30_360_US d1 d2
+ ]
+
+tsTest = 
+  let
+    d1 = T.fromGregorian 2007 12 28
+    d2 = T.fromGregorian 2008 2 28
+    dpairs = [(toDate "20061201",100)
+              ,(toDate "20070201",80)  
+              ,(toDate "20080201",60)]
+    ed =  (toDate "20090101")
+    testTs = mkTs [(toDate "20061201",100)
+                  ,(toDate "20070201",80)  
+                  ,(toDate "20080201",60)]
+    tps = [TsPoint _d _v | (_d,_v) <- dpairs ]
+
+    rateCurve = FloatCurve [TsPoint (toDate "20061201") 0.03
+                           ,TsPoint (toDate "20070201") 0.05
+                           ,TsPoint (toDate "20080201") 0.07]
+
+    factorCurve = FloatCurve [TsPoint (toDate "20061201") 1.0
+                             ,TsPoint (toDate "20070201") 0.8
+                             ,TsPoint (toDate "20080201") 0.6]
+  in
+    testGroup "Test Trigger Factor Curve"
+  [
+    testCase "" $
+      assertEqual "left most" 
+        [0,100,80,60] $
+        getValByDates testTs Exc [(toDate "20061201")
+                                 ,(toDate "20061211")
+                                 ,(toDate "20070301")
+                                 ,(toDate "20081201")]
+
+    ,testCase "FactorCurveClosed" $                         
+      assertEqual "leftNotFound as 1"
+        1.0 $
+        getValByDate 
+          (FactorCurveClosed tps ed)
+          Exc
+          (toDate "20060601")
+    ,testCase "FactorCurveClosed" $                         
+      assertEqual "in middle"
+        80 $
+        getValByDate 
+          (FactorCurveClosed tps ed)
+          Exc
+          (toDate "20070202")          
+    ,testCase "FactorCurveClosed" $                         
+      assertEqual "right after last dps"
+        60 $
+        getValByDate 
+          (FactorCurveClosed tps ed)
+          Exc
+          (toDate "20081221") 
+    ,testCase "FactorCurveClosed" $                         
+      assertEqual "After end date" 
+        1.0 $
+        getValByDate 
+          (FactorCurveClosed tps ed)
+          Exc
+          (toDate "20090601")
+    ,testCase "Multiply Ts" $
+      assertEqual " multiplyTs 1 "
+        (mkTs [(toDate "20061201", 0.03) ,(toDate "20070201", 0.04),(toDate "20080201", 0.042)]) 
+        (multiplyTs Inc rateCurve factorCurve)
+
+  ]
+
+ts2Test = 
+    let 
+       testThresholdCurve = ThresholdCurve [(TsPoint (toDate "20220101") (1 % 100))
+                                           ,(TsPoint (toDate "20220201") (2 % 100))
+                                           ,(TsPoint (toDate "20220301") (3 % 100))]
+    in 
+    testGroup "Test Trigger Threshold Curve"
+  [
+    testCase "" $
+      assertEqual "left most" 
+        (1 % 100) $
+        getValByDate testThresholdCurve Inc (toDate "20211201")
+    ,testCase "" $
+      assertEqual "on first-ts" 
+        (1 % 100) $
+        getValByDate testThresholdCurve Inc (toDate "20220101")
+    ,testCase "" $
+      assertEqual "after first-ts" 
+        (2 % 100) $
+        getValByDate testThresholdCurve Inc (toDate "20220110")
+    ,testCase "" $
+      assertEqual "Right most" 
+        (3 % 100) $
+        getValByDate testThresholdCurve Inc (toDate "20220310")
+  ]
+
+-- ^ date pattern test
+dateVectorPatternTest = 
+  let 
+    a = 1
+  in 
+    testGroup "Test on Date Vector generation"
+    [ testCase "" $
+        assertEqual "LeapYear&Month End"
+          [(toDate "20240229"), (toDate "20240331")]
+          (genSerialDates MonthEnd Inc (toDate "20240215") 2)
+    , testCase "Week Day Test" $
+        assertEqual "week day 2"
+          [(toDate "20240514"), (toDate "20240521")]
+          (genSerialDates (Weekday 2) Inc (toDate "20240509") 2)
+    , testCase "Week Day Test" $
+        assertEqual "week day 0"
+          [(toDate "20240512"), (toDate "20240519")]
+          (genSerialDates (Weekday 0) Inc (toDate "20240509") 2)
+    , testCase "" $
+        assertEqual "till test"
+        [(toDate "20220131"),(toDate "20220228")]
+        (genSerialDatesTill (toDate "20220101") MonthEnd (toDate "20220315"))
+    , testCase "First Date in Pattern" $
+        assertEqual ""
+         [(toDate "20220630"),(toDate "20220731"),(toDate "20220831")]
+         (genSerialDatesTill2 IE (toDate "20220630") MonthEnd (toDate "20220901"))
+    , testCase "Custom Dates" $
+        assertEqual "exatct same length"
+         [(toDate "20230202"),(toDate "20230909")]
+         (genSerialDatesTill2 EE (toDate "20200630") (CustomDate [toDate "20230202", toDate "20230909"] ) (toDate "20230910"))
+    , testCase "Custom Dates" $
+        assertEqual "Include both ends"
+         [(toDate "20200630"), (toDate "20230202"),(toDate "20230909"), (toDate "20230910")]
+         (genSerialDatesTill2 II (toDate "20200630") (CustomDate [toDate "20230202", toDate "20230909"] ) (toDate "20230910"))
+    , testCase "Mutiple Date Pattern" $
+        assertEqual ""
+         [(toDate "20230909"), (toDate "20230919")]
+         (genSerialDatesTill2 EE 
+            (toDate "20200630") 
+            (AllDatePattern
+              [(CustomDate [toDate "20230909"]),(CustomDate [toDate "20230919"])])
+            (toDate "20230930"))
+    , testCase "" $
+        assertEqual "Generate Dates by N Month"
+        (toDates ["20220201","20220401","20220601"])
+        (genSerialDatesTill (toDate "20220101") (EveryNMonth (toDate "20220201") 2) (toDate "20220715"))
+    , testCase "exclude dates" $
+        assertEqual "Exclude Dates "
+         [(toDate "20230909")]
+         (genSerialDatesTill2 EE (toDate "20200630") 
+             (Exclude 
+              (CustomDate [toDate "20230202", toDate "20230909"] )
+              [(CustomDate [toDate "20230202"] )])
+              (toDate "20230910"))
+    , testCase "offset by dates" $
+        assertEqual "offset by dates"
+         [(toDate "20230204"),(toDate "20230911")]
+         (genSerialDatesTill2 EE 
+           (toDate "20200630") 
+           (OffsetBy 
+             (CustomDate [toDate "20230202", toDate "20230909"]) 2)
+           (toDate "20230910"))
+    , testCase "No Inclusive or Exclusive" $
+        assertEqual "1"
+        (toDates ["20230831","20230930","20231031"])
+        (genSerialDatesTill2 NO_IE (toDate "20230810") MonthEnd (toDate "20231031") )
+    , testCase "No Inclusive or Exclusive" $
+        assertEqual "2"
+        (toDates ["20230831","20230930"])
+        (genSerialDatesTill2 NO_IE (toDate "20230810") MonthEnd (toDate "20231030") )
+    , testCase "No Inclusive or Exclusive" $
+        assertEqual "3"
+        (toDates ["20230831","20230930","20231031"])
+        (genSerialDatesTill2 NO_IE (toDate "20230831") MonthEnd (toDate "20231031") )
+    , testCase "No Inclusive or Exclusive" $
+        assertEqual "4"
+        (toDates ["20230831","20230930"])
+        (genSerialDatesTill2 NO_IE (toDate "20230831") MonthEnd (toDate "20231030") )
+    , testCase "starts " $
+        assertEqual " inc "
+        (toDates ["20230930"])
+        (genSerialDatesTill2 NO_IE (toDate "20230831") (StartsAt Inc (toDate "20230901") MonthEnd) (toDate "20231030") )
+    , testCase "starts " $
+        assertEqual " inc "
+        (toDates ["20230831", "20230930"])
+        (genSerialDatesTill2 NO_IE (toDate "20230831") (StartsAt Inc (toDate "20230831") MonthEnd) (toDate "20231030") )
+    , testCase "ends " $
+        assertEqual " inc "
+        (toDates ["20230831"])
+        (genSerialDatesTill2 NO_IE (toDate "20230831") (EndsAt Inc (toDate "20230901") MonthEnd) (toDate "20231030") )
+    , testCase "ends " $
+        assertEqual " inc "
+        (toDates ["20230831"])
+        (genSerialDatesTill2 NO_IE (toDate "20230831") (EndsAt Inc (toDate "20230831") MonthEnd) (toDate "20231030") )
+    , testCase "ends " $
+        assertEqual " exc "
+        ([])
+        (genSerialDatesTill2 NO_IE (toDate "20230831") (EndsAt Exc (toDate "20230831") MonthEnd) (toDate "20231030") )
+    ]                          
+
+paddingTest = 
+    let 
+      a = [1,2,3]
+    in 
+      testGroup "padding"
+      [ testCase "" $
+          assertEqual "padding+"
+          [1,2,3,0]
+          (paddingDefault 0 a 4)
+       ,testCase "" $
+          assertEqual "padding-"
+          [1,2]
+          (paddingDefault 0 a 2)
+      ]
+
+dateSliceTest = 
+    let 
+        ds = [(toDate "20230101"),(toDate "20230201"),(toDate "20230301")]
+    in 
+        testGroup "slice dates"
+        [ testCase "sliceAfterkeepPrevious" $ 
+            assertEqual ""
+            ds
+            (sliceDates (SliceAfterKeepPrevious (toDate "20230115")) ds)
+        , testCase "sliceAfterkeepPrevious" $ 
+            assertEqual ""
+            (tail ds)
+            (sliceDates (SliceAfterKeepPrevious (toDate "20230215")) ds)
+        ]
+
+capTest = 
+    let 
+      a = [1,2,3,4]
+    in 
+      testGroup "Cap Test"
+      [ testCase "Cap with 2" $ 
+        assertEqual "Cap with 2" 
+        [1,2,2,2]
+        (capWith 2 a)
+      ,testCase "No Cap" $ 
+        assertEqual "No Cap" 
+        [1,2,3,4]
+        (capWith 5 a)
+      ]
+
+ts3Test = 
+  let 
+    ts1 = IRateCurve [TsPoint (toDate "20230301") 0.03,TsPoint (toDate "20230301") 0.05]
+  in 
+    testGroup "curve update test"
+    [ testCase "shift curve" $ 
+      assertEqual "Shift RateCurve by 0.01"
+      (IRateCurve [TsPoint (toDate "20230301") 0.04,TsPoint (toDate "20230301") 0.06]) $
+      (shiftTsByAmt ts1 0.01)
+    ]
+
+roundingTest = 
+    testGroup "rounding by test"
+    [ testCase "Rounding on Rate" $
+      assertEqual "Rounding Floor"
+      0.02
+      (roundingBy (RoundFloor 0.00125) 0.02124)
+    , testCase "Rounding on Rate" $
+      assertEqual "Rounding Ceiling"
+      0.02
+      (roundingBy (RoundCeil 0.00125) 0.01876)
+    , testCase "Rounding on Rate" $
+      assertEqual "Rounding Equal"
+      0.02
+      (roundingBy (RoundCeil 0.00125) 0.02)
+    , testCase "Rounding on Balance" $
+      assertEqual "Rounding Ceiling"
+      100
+      (roundingBy (RoundCeil 5) 96)
+    , testCase "Rounding on Balance" $
+      assertEqual "Rounding Floor"
+      100
+      (roundingBy (RoundFloor 5) 104)
+    , testCase "Rounding on Balance" $
+      assertEqual "Rounding Equal"
+      100
+      (roundingBy (RoundFloor 5) 100)
+    ]
+
+sliceTest = 
+  testGroup "sliceTest"
+  [ testCase "slice 1" $
+    assertEqual ""
+    [1]
+    (slice 0 1 [1,2,3])
+  , testCase "slice 2" $
+    assertEqual ""
+    []
+    (slice 0 0 [1,2,3])
+  , testCase "slice 2" $
+    assertEqual ""
+    [1,2,3]
+    (slice 0 3 [1,2,3])
+  , testCase "slice 3" $
+    assertEqual ""
+    [1,2,3]
+    (slice 0 4 [1,2,3])
+  ]
+
+splitTsTest = 
+  let 
+    cashflow = [CF.CashFlow (toDate "20230901") 10, CF.CashFlow (toDate "20231001") 10,CF.CashFlow (toDate "20231101") 10]
+  in 
+
+    testGroup "split times series test"
+    [ testCase "split before earliest" $
+       assertEqual "" 
+       ([],cashflow)
+       (splitBy (toDate "20230801") Inc cashflow )
+      ,testCase "split after latest" $
+       assertEqual "" 
+       (cashflow,[])
+       (splitBy (toDate "20231201") Inc cashflow )
+       ,testCase "split in middle,inclusive" $
+       assertEqual "" 
+       ([CF.CashFlow (toDate "20230901") 10, CF.CashFlow (toDate "20231001") 10],[CF.CashFlow (toDate "20231101") 10])
+       (splitBy (toDate "20231001") Inc cashflow )
+       ,testCase "split in middle,exclusive" $
+       assertEqual "" 
+       ([CF.CashFlow (toDate "20230901") 10],[CF.CashFlow (toDate "20231001") 10,CF.CashFlow (toDate "20231101") 10])
+       (splitBy (toDate "20231001") Exc cashflow )
+    ]
+
+tableTest = 
+  let 
+    tbl = ThresholdTable [(5,100),(10,200),(15,300),(20,400)]
+  in 
+    testGroup "lookup table down"
+    [ 
+      testCase "down & inclusive" $
+      assertEqual ""
+      [Nothing,Just 100,Just 100]
+      [lookupTable tbl Down (3 >=),lookupTable tbl Down (5 >=),lookupTable tbl Down (12 >=)]
+    ,testCase "down & exclusive" $
+      assertEqual ""
+      [Nothing,Nothing,Just 100]
+      [lookupTable tbl Down (3 >),lookupTable tbl Down (5 >),lookupTable tbl Down (6 >)]
+    ,testCase "up & inclusive" $
+      assertEqual ""
+      [Nothing,Just 100,Just 100]
+      [lookupTable tbl Up (3 >=),lookupTable tbl Up (5 >=),lookupTable tbl Up (6 >=)]
+    ,testCase "up & exclusive" $
+      assertEqual ""
+      [Just 400, Just 300, Just 200, Nothing]
+      [lookupTable tbl Up (20 >=),lookupTable tbl Up (16 >=),lookupTable tbl Up (11 >=),lookupTable tbl Up (3 >=) ]
+    ,testCase "table interval" $
+      assertEqual " Up first "
+      (Just ((5,100),(10,200)))
+      (lookupIntervalTable tbl Down (5 >=))
+    ,testCase "table interval 1" $
+      assertEqual " Up second "
+      (Just ((15,300),(20,400)))
+      (lookupIntervalTable tbl Down (\x -> x >= 12))
+    ,testCase "table interval 2" $
+      assertEqual " Up last" 
+      Nothing 
+      (lookupIntervalTable tbl Down (>= 20))
+    ]
+
+lastOftest = 
+  let 
+    a = [1,2,3,4,5]
+    b = [[1],[3],[],[5],[],[]]
+  in 
+    testGroup "test on last of on list" [
+      testCase "on non empty" $
+      assertEqual "should be [5]"
+      (Just [5])
+      (Util.lastOf b (not . null))
+    ]
+
+
+paySeqTest = 
+  let 
+    d1 = toDate "20200101"
+    bnd1 = L.Bond "A" L.Sequential (L.OriginalInfo 100 d1 0.06 Nothing) (L.Fix 0.05 DC_ACT_365F) Nothing 100 0.08 0 0 0 Nothing Nothing Nothing Nothing
+    bnd2 = L.Bond "B" L.Sequential (L.OriginalInfo 100 d1 0.06 Nothing) (L.Fix 0.05 DC_ACT_365F) Nothing 100 0.08 0 0 0 Nothing Nothing Nothing Nothing
+    writeAmt1 = 100 
+  in 
+  testGroup "write off on bond" [
+    testCase "write off on bond 1" $
+    assertEqual "only 1st bond is written off by 70"
+    (Right ([bnd1 {L.bndBalance = 30,L.bndStmt = Just (Statement (DL.fromList ([BondTxn d1 30.00 0.00 0.00 0.000000 0.00 0.00 0.00 Nothing (WriteOff "A" 70.00)])))}
+            , bnd2],0))
+    (paySeqM d1 70 L.bndBalance (L.writeOff d1) (Right []) [bnd1,bnd2])
+    ,testCase "write off on bond 2" $
+    assertEqual "2st bond is written off by 70"
+    (Right ([bnd1 {L.bndBalance = 0,L.bndStmt = Just (Statement  (DL.fromList ([BondTxn d1 0.00 0.00 0.00 0.000000 0.00 0.00 0.00 Nothing (WriteOff "A" 100.00)])))}
+            , bnd2{L.bndBalance = 70,L.bndStmt = Just (Statement (DL.fromList ([BondTxn d1 70.00 0.00 0.00 0.000000 0.00 0.00 0.00 Nothing (WriteOff "B" 30.00)])))}
+            ],0))
+    (paySeqM d1 130 L.bndBalance (L.writeOff d1) (Right []) [bnd1,bnd2])
+    ,testCase "write off on all bonds " $
+    assertEqual "over write off"
+    (Right ([bnd1 {L.bndBalance = 0,L.bndStmt = Just (Statement (DL.fromList ([BondTxn d1 0.00 0.00 0.00 0.000000 0.00 0.00 0.00 Nothing (WriteOff "A" 100.00)])))}
+            , bnd2{L.bndBalance = 0,L.bndStmt = Just (Statement (DL.fromList ([BondTxn d1 0.00 0.00 0.00 0.000000 0.00 0.00 0.00 Nothing (WriteOff "B" 100.00)])))}
+            ],30))
+    (paySeqM d1 230 L.bndBalance (L.writeOff d1) (Right []) [bnd1,bnd2])
+  ]
+
+scaleListTest = 
+  let 
+    a = 1
+  in 
+    testGroup "scale list test"
+    [ testCase "" $
+        assertEqual "scale list"
+        [50.0, 37.5, 25.0]
+        $ scaleByFstElement 50 [200.0,150.0,100]
+      , testCase "" $
+        assertEqual "scale list"
+        []
+        $ scaleByFstElement 50 []
+    ]