packages feed

Hastructure (empty) → 0.45.0

raw patch · 68 files changed

+21463/−0 lines, 68 filesdep +Decimaldep +Hastructuredep +MissingHsetup-changed

Dependencies added: Decimal, Hastructure, MissingH, aeson, aeson-pretty, attoparsec, attoparsec-aeson, base, base-compat, bytestring, containers, deepseq, dlist, exceptions, generic-lens, hashable, http-types, ieee754, lens, math-functions, monad-loops, mtl, numeric-limits, openapi3, parallel, regex-base, regex-pcre-builtin, regex-tdfa, scientific, servant, servant-openapi3, servant-server, split, string-conversions, swagger2, tabular, tasty, tasty-golden, tasty-hspec, tasty-hunit, template-haskell, text, time, vector, wai, wai-cors, warp, yaml

Files

+ CHANGELOG.md view
@@ -0,0 +1,519 @@+# Changelog for Hastructure++<!-- towncrier release notes start -->++## 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 <n>` 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 <Date>,<Spread>,<WAL/Spread> 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 <predicate> 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 = `<formula 1> - <formula 2>`+* 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 `<datePattern>`+++## 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` <date pattern>+++## 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+++
+ Hastructure.cabal view
@@ -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 <https://github.com/yellowbean/Hastructure#readme>+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
+ LICENSE view
@@ -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.
+ README.md view
@@ -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)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -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
+ app/MainBase.hs view
@@ -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
+ src/Accounts.hs view
@@ -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)
+ src/Analytics.hs view
@@ -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
+ src/Asset.hs view
@@ -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
+ src/AssetClass/AssetBase.hs view
@@ -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
+ src/AssetClass/AssetCashflow.hs view
@@ -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
+ src/AssetClass/FixedAsset.hs view
@@ -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)
+ src/AssetClass/Installment.hs view
@@ -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 ]++
+ src/AssetClass/Lease.hs view
@@ -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]+
+ src/AssetClass/Loan.hs view
@@ -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 ]
+ src/AssetClass/MixedAsset.hs view
@@ -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
+ src/AssetClass/Mortgage.hs view
@@ -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 ]+  +
+ src/AssetClass/ProjectedCashFlow.hs view
@@ -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
+ src/AssetClass/Receivable.hs view
@@ -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
+ src/Assumptions.hs view
@@ -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])
+ src/Call.hs view
@@ -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)
+ src/Cashflow.hs view
@@ -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)
+ src/CreditEnhancement.hs view
@@ -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)
+ src/DateUtil.hs view
@@ -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)
+ src/Deal.hs view
@@ -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)+++-- <Legacy Test>, <Test on dates>+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)
+ src/Deal/DealAction.hs view
@@ -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 <limit> 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 <formula> +-- ^ 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)
+ src/Deal/DealBase.hs view
@@ -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)+              -- <Pool Collection DP> <Waterfall DP> +              --  (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])
+ src/Deal/DealDate.hs view
@@ -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"
+ src/Deal/DealMod.hs view
@@ -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
+ src/Deal/DealQuery.hs view
@@ -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)
+ src/Deal/DealValidation.hs view
@@ -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
+ src/Errors.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE ScopedTypeVariables #-}+++module Errors(EngineError(..))+ where+++++data EngineError = DivideZero +                 | NoComponentFound+                 | NotValidAction+                 deriving (Show,Eq,Ord,Read)
+ src/Expense.hs view
@@ -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)
+ src/Hedge.hs view
@@ -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])
+ src/InterestRate.hs view
@@ -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)
+ src/Ledger.hs view
@@ -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)
+ src/Liability.hs view
@@ -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)
+ src/Lib.hs view
@@ -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
+ src/Pool.hs view
@@ -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)
+ src/Reports.hs view
@@ -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)
+ src/Revolving.hs view
@@ -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)
+ src/Stmt.hs view
@@ -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)
+ src/Triggers.hs view
@@ -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])
+ src/Types.hs view
@@ -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 <HERE> collection action , waterfall action+               | EndCollectionWF       -- ^ | collection period  collection action <HERE>, waterfall action+               | BeginDistributionWF   -- ^ | collection period  collection action , <HERE>waterfall action+               | EndDistributionWF     -- ^ | collection period  collection action , waterfall action<HERE>+               | InWF                  -- ^ | collection period  collection action , waterfall <HERE> 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 $ "<PayInt:"++ listToStrWithComma bns ++ ">"+  toJSON (PayYield bn ) = String $ T.pack $ "<PayYield:"++ bn ++">"+  toJSON (PayPrin bns ) =  String $ T.pack $ "<PayPrin:"++ listToStrWithComma bns ++ ">"+  toJSON (WriteOff bn amt ) =  String $ T.pack $ "<WriteOff:"++ bn ++","++ show amt ++ ">"+  toJSON (FundWith b bal) = String $ T.pack $ "<FundWith:"++b++","++show bal++">"+  toJSON (PayPrinResidual bns ) =  String $ T.pack $ "<PayPrinResidual:"++ listToStrWithComma bns ++ ">"+  toJSON (PayFee fn ) =  String $ T.pack $ "<PayFee:" ++ fn ++ ">"+  toJSON (SeqPayFee fns) =  String $ T.pack $ "<SeqPayFee:"++ listToStrWithComma fns++">"+  toJSON (PayFeeYield fn) =  String $ T.pack $ "<PayFeeYield:"++ fn++">"+  toJSON (Transfer an1 an2) =  String $ T.pack $ "<Transfer:"++ an1 ++","++ an2++">"+  toJSON (TransferBy an1 an2 limit) =  String $ T.pack $ "<TransferBy:"++ an1 ++","++ an2++","++show limit++">"+  toJSON (PoolInflow mPids ps) =  String $ T.pack $ "<Pool"++ maybe "" (intercalate "|" . (show <$>)) mPids ++":"++ show ps++">"+  toJSON (LiquidationProceeds pids) =  String $ T.pack $ "<Liquidation:"++ listToStrWithComma (show <$> pids) ++">"+  toJSON (UsingDS ds) =  String $ T.pack $ "<DS:"++ show ds++">"+  toJSON BankInt =  String $ T.pack $ "<BankInterest:>"+  toJSON Empty =  String $ T.pack $ "" +  toJSON (LiquidationSupport source) = String $ T.pack $ "<Support:"++source++">"+  toJSON (LiquidationSupportInt b1 b2) =  String $ T.pack $ "<SupportExp:(Int:"++ show b1 ++ ",Fee:" ++ show b2 ++")>"+  toJSON LiquidationDraw = String $ T.pack $ "<Draw:>"+  toJSON (LiquidationRepay s) = String $ T.pack $ "<Repay:"++ s ++">"+  toJSON SwapAccrue = String $ T.pack $ "<Accure:>"+  toJSON (SwapInSettle s)= String $ T.pack $ "<SettleIn:"++ s ++">"+  toJSON (SwapOutSettle s) = String $ T.pack $ "<SettleOut:"++ s ++">"+  toJSON (PurchaseAsset rPoolName bal) = String $ T.pack $ "<PurchaseAsset:"<> rPoolName <>","++show bal++">"+  toJSON (TxnDirection dr) = String $ T.pack $ "<TxnDirection:"++show dr++">"+  toJSON SupportDraw = String $ T.pack $ "<SupportDraw:>"+  toJSON (IssuanceProceeds nb) = String $ T.pack $ "<IssuanceProceeds:"++nb++">"+  toJSON (Tag cmt) = String $ T.pack $ "<Tag:"++cmt++">"+  toJSON (TxnComments tcms) = Array $ V.fromList $ map toJSON tcms+  toJSON (PayGroupInt bns) = String $ T.pack $ "<PayGroupInt:"++ listToStrWithComma bns ++ ">"+  toJSON (PayGroupPrin bns) = String $ T.pack $ "<PayGroupPrin:"++ listToStrWithComma bns ++ ">"+  toJSON (BookLedgerBy dr lName) = String $ T.pack $ "<BookLedger:"++ lName ++ ">"+  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 "<BankInt>" = 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:"++nb++">"+  "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] )
+ src/Util.hs view
@@ -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 = ""
+ src/Validation.hs view
@@ -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
+ src/Waterfall.hs view
@@ -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 <pre> is true +            | ActionWithPre2 Pre [Action] [Action]  -- ^ execute action1 if <pre> 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)
+ test/DealTest/DealTest.hs view
@@ -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)+   ]+
+ test/DealTest/MultiPoolDealTest.hs view
@@ -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)+   ]
+ test/DealTest/ResecDealTest.hs view
@@ -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"]+}
+ test/DealTest/RevolvingTest.hs view
@@ -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+   ]+
+ test/MainTest.hs view
@@ -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+                           ]
+ test/UT/AccountTest.hs view
@@ -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"]))+     ]++
+ test/UT/AnalyticsTest.hs view
@@ -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)+  ]
+ test/UT/AssetTest.hs view
@@ -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))))+    ]
+ test/UT/BondTest.hs view
@@ -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)+  ]
+ test/UT/CashflowTest.hs view
@@ -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)]+                            ))                            +    ]
+ test/UT/CeTest.hs view
@@ -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 ))    +  ]
+ test/UT/DealTest.hs view
@@ -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)+      ]
+ test/UT/DealTest2.hs view
@@ -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+  ]
+ test/UT/ExpTest.hs view
@@ -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" $+--    [+--+--+--    ]+
+ test/UT/InterestRateTest.hs view
@@ -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)+    +  ]
+ test/UT/LibTest.hs view
@@ -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])+    ]
+ test/UT/QueryTest.hs view
@@ -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++      ]
+ test/UT/RateHedgeTest.hs view
@@ -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)+    ]
+ test/UT/StmtTest.hs view
@@ -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+                            ]++    ]+
+ test/UT/UtilTest.hs view
@@ -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 []+    ]