{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}

module Deal (run,getInits,runDeal,ExpectReturn(..)
            ,performAction
            ,populateDealDates
            ,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 Deal.DealCollection
import Deal.DealRun
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 :: c -> String -> c
debug = (String -> c -> c) -> c -> String -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> c -> c
forall a. String -> a -> a
trace


updateSrtRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> HE.SRT -> Either String HE.SRT
updateSrtRate :: forall a.
Asset a =>
TestDeal a -> Date -> [RateAssumption] -> SRT -> Either String SRT
updateSrtRate TestDeal a
t Date
d [RateAssumption]
ras srt :: SRT
srt@HE.SRT{srtPremiumType :: SRT -> RateType
HE.srtPremiumType = RateType
rt} 
    = do 
        IRate
r <- RateType -> Date -> [RateAssumption] -> Either String IRate
AP.applyFloatRate2 RateType
rt Date
d [RateAssumption]
ras 
        SRT -> Either String SRT
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return SRT
srt { HE.srtPremiumRate = r }


accrueSrt :: Ast.Asset a => TestDeal a -> Date -> HE.SRT -> Either String HE.SRT
accrueSrt :: forall a. Asset a => TestDeal a -> Date -> SRT -> Either String SRT
accrueSrt TestDeal a
t Date
d srt :: SRT
srt@HE.SRT{ srtDuePremium :: SRT -> Balance
HE.srtDuePremium = Balance
duePrem, srtRefBalance :: SRT -> Balance
HE.srtRefBalance = Balance
bal, srtPremiumRate :: SRT -> IRate
HE.srtPremiumRate = IRate
rate
                        , srtDuePremiumDate :: SRT -> Maybe Date
HE.srtDuePremiumDate = Maybe Date
mDueDate,  srtType :: SRT -> SrtType
HE.srtType = SrtType
st
                        , srtStart :: SRT -> Date
HE.srtStart = Date
sd } 
  = do 
      Rate
newBal <- case SrtType
st of
                  HE.SrtByEndDay DealStats
ds DatePattern
dp -> TestDeal a -> Date -> DealStats -> Either String Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
      let newPremium :: Balance
newPremium = Balance
duePrem Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+  Balance -> Date -> Date -> IRate -> DayCount -> Balance
calcInt (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
newBal) (Date -> Maybe Date -> Date
forall a. a -> Maybe a -> a
fromMaybe Date
sd Maybe Date
mDueDate) Date
d IRate
rate DayCount
DC_ACT_365F
      let accrueInt :: Balance
accrueInt = Balance -> Date -> Date -> IRate -> DayCount -> Balance
calcInt (SRT -> Balance
HE.srtRefBalance SRT
srt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
duePrem) (Date -> Maybe Date -> Date
forall a. a -> Maybe a -> a
fromMaybe Date
d (SRT -> Maybe Date
HE.srtDuePremiumDate SRT
srt)) Date
d (SRT -> IRate
HE.srtPremiumRate SRT
srt) DayCount
DC_ACT_365F
      SRT -> Either String SRT
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return SRT
srt { HE.srtRefBalance = fromRational newBal, HE.srtDuePremium = newPremium, HE.srtDuePremiumDate = Just d}


-- ^ test if a clean up call should be fired
testCall :: Ast.Asset a => TestDeal a -> Date -> C.CallOption -> Either String Bool 
testCall :: forall a.
Asset a =>
TestDeal a -> Date -> CallOption -> Either String Bool
testCall TestDeal a
t Date
d CallOption
opt = 
    case CallOption
opt of 
       C.PoolBalance Balance
x -> (Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance
x) (Balance -> Bool) -> (Rate -> Balance) -> Rate -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational (Rate -> Bool) -> Either String Rate -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either String Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rate
queryCompound TestDeal a
t Date
d (Maybe [PoolId] -> DealStats
FutureCurrentPoolBalance Maybe [PoolId]
forall a. Maybe a
Nothing)
       C.BondBalance Balance
x -> (Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance
x) (Balance -> Bool) -> (Rate -> Balance) -> Rate -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational (Rate -> Bool) -> Either String Rate -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either String Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rate
queryCompound TestDeal a
t Date
d DealStats
CurrentBondBalance
       C.PoolFactor Rate
x ->  (Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
< Rate
x) (Rate -> Bool) -> Either String Rate -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either String Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rate
queryCompound TestDeal a
t Date
d (Date -> Maybe [PoolId] -> DealStats
FutureCurrentPoolFactor Date
d Maybe [PoolId]
forall a. Maybe a
Nothing)  -- `debug` ("D "++show d++ "Pool Factor query ->" ++ show (queryDealRate t (FutureCurrentPoolFactor d)))
       C.BondFactor Rate
x ->  (Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
< Rate
x) (Rate -> Bool) -> Either String Rate -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either String Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rate
queryCompound TestDeal a
t Date
d DealStats
BondFactor
       C.OnDate Date
x -> Bool -> Either String Bool
forall a b. b -> Either a b
Right (Bool -> Either String Bool) -> Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$ Date
x Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== Date
d 
       C.AfterDate Date
x -> Bool -> Either String Bool
forall a b. b -> Either a b
Right (Bool -> Either String Bool) -> Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$ Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
x
       C.And [CallOption]
xs -> (CallOption -> Either String Bool)
-> [CallOption] -> Either String Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM (TestDeal a -> Date -> CallOption -> Either String Bool
forall a.
Asset a =>
TestDeal a -> Date -> CallOption -> Either String Bool
testCall TestDeal a
t Date
d) [CallOption]
xs
       C.Or [CallOption]
xs -> (CallOption -> Either String Bool)
-> [CallOption] -> Either String Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (TestDeal a -> Date -> CallOption -> Either String Bool
forall a.
Asset a =>
TestDeal a -> Date -> CallOption -> Either String Bool
testCall TestDeal a
t Date
d) [CallOption]
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
pre -> Date -> TestDeal a -> Pre -> Either String Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either String Bool
testPre Date
d TestDeal a
t Pre
pre
       CallOption
_ -> String -> Either String Bool
forall a b. a -> Either a b
Left (String
"failed to find call options"String -> String -> String
forall a. [a] -> [a] -> [a]
++ CallOption -> String
forall a. Show a => a -> String
show CallOption
opt)


queryTrigger :: Ast.Asset a => TestDeal a -> DealCycle -> [Trigger]
queryTrigger :: forall a. Asset a => TestDeal a -> DealCycle -> [Trigger]
queryTrigger t :: TestDeal a
t@TestDeal{ triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map String Trigger))
triggers = Maybe (Map DealCycle (Map String Trigger))
trgs } DealCycle
wt 
  = case Maybe (Map DealCycle (Map String Trigger))
trgs of 
      Maybe (Map DealCycle (Map String Trigger))
Nothing -> []
      Just Map DealCycle (Map String Trigger)
_trgs -> [Trigger]
-> (Map String Trigger -> [Trigger])
-> Maybe (Map String Trigger)
-> [Trigger]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Map String Trigger -> [Trigger]
forall k a. Map k a -> [a]
Map.elems (Maybe (Map String Trigger) -> [Trigger])
-> Maybe (Map String Trigger) -> [Trigger]
forall a b. (a -> b) -> a -> b
$ DealCycle
-> Map DealCycle (Map String Trigger) -> Maybe (Map String Trigger)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DealCycle
wt Map DealCycle (Map String Trigger)
_trgs

-- ^ test triggers in the deal and add a log if deal status changed
changeDealStatus:: Ast.Asset a => (Date,String)-> DealStatus -> TestDeal a -> (Maybe ResultComponent, TestDeal a)
changeDealStatus :: forall a.
Asset a =>
(Date, String)
-> DealStatus -> TestDeal a -> (Maybe ResultComponent, TestDeal a)
changeDealStatus (Date, String)
_ DealStatus
_ t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=Ended Maybe Date
_} = (Maybe ResultComponent
forall a. Maybe a
Nothing, TestDeal a
t) 
changeDealStatus (Date
d,String
why) DealStatus
newSt t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=DealStatus
oldSt} 
  | DealStatus
newSt DealStatus -> DealStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= DealStatus
oldSt = (ResultComponent -> Maybe ResultComponent
forall a. a -> Maybe a
Just (Date -> DealStatus -> DealStatus -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
oldSt DealStatus
newSt String
why), TestDeal a
t {status=newSt})
  | Bool
otherwise = (ResultComponent -> Maybe ResultComponent
forall a. a -> Maybe a
Just (Date -> DealStatus -> DealStatus -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
oldSt DealStatus
newSt (String
"Duplicate status change: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
why)), TestDeal a
t) 


-- reserved for future used
data ExpectReturn = DealLogs
                  | AssetLevelFlow
                  deriving (Int -> ExpectReturn -> String -> String
[ExpectReturn] -> String -> String
ExpectReturn -> String
(Int -> ExpectReturn -> String -> String)
-> (ExpectReturn -> String)
-> ([ExpectReturn] -> String -> String)
-> Show ExpectReturn
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ExpectReturn -> String -> String
showsPrec :: Int -> ExpectReturn -> String -> String
$cshow :: ExpectReturn -> String
show :: ExpectReturn -> String
$cshowList :: [ExpectReturn] -> String -> String
showList :: [ExpectReturn] -> String -> String
Show,(forall x. ExpectReturn -> Rep ExpectReturn x)
-> (forall x. Rep ExpectReturn x -> ExpectReturn)
-> Generic ExpectReturn
forall x. Rep ExpectReturn x -> ExpectReturn
forall x. ExpectReturn -> Rep ExpectReturn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpectReturn -> Rep ExpectReturn x
from :: forall x. ExpectReturn -> Rep ExpectReturn x
$cto :: forall x. Rep ExpectReturn x -> ExpectReturn
to :: forall x. Rep ExpectReturn x -> ExpectReturn
Generic,Eq ExpectReturn
Eq ExpectReturn =>
(ExpectReturn -> ExpectReturn -> Ordering)
-> (ExpectReturn -> ExpectReturn -> Bool)
-> (ExpectReturn -> ExpectReturn -> Bool)
-> (ExpectReturn -> ExpectReturn -> Bool)
-> (ExpectReturn -> ExpectReturn -> Bool)
-> (ExpectReturn -> ExpectReturn -> ExpectReturn)
-> (ExpectReturn -> ExpectReturn -> ExpectReturn)
-> Ord ExpectReturn
ExpectReturn -> ExpectReturn -> Bool
ExpectReturn -> ExpectReturn -> Ordering
ExpectReturn -> ExpectReturn -> ExpectReturn
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExpectReturn -> ExpectReturn -> Ordering
compare :: ExpectReturn -> ExpectReturn -> Ordering
$c< :: ExpectReturn -> ExpectReturn -> Bool
< :: ExpectReturn -> ExpectReturn -> Bool
$c<= :: ExpectReturn -> ExpectReturn -> Bool
<= :: ExpectReturn -> ExpectReturn -> Bool
$c> :: ExpectReturn -> ExpectReturn -> Bool
> :: ExpectReturn -> ExpectReturn -> Bool
$c>= :: ExpectReturn -> ExpectReturn -> Bool
>= :: ExpectReturn -> ExpectReturn -> Bool
$cmax :: ExpectReturn -> ExpectReturn -> ExpectReturn
max :: ExpectReturn -> ExpectReturn -> ExpectReturn
$cmin :: ExpectReturn -> ExpectReturn -> ExpectReturn
min :: ExpectReturn -> ExpectReturn -> ExpectReturn
Ord,ExpectReturn -> ExpectReturn -> Bool
(ExpectReturn -> ExpectReturn -> Bool)
-> (ExpectReturn -> ExpectReturn -> Bool) -> Eq ExpectReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpectReturn -> ExpectReturn -> Bool
== :: ExpectReturn -> ExpectReturn -> Bool
$c/= :: ExpectReturn -> ExpectReturn -> Bool
/= :: ExpectReturn -> ExpectReturn -> Bool
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 :: IrrType -> [Txn] -> Either String (Rate, [Txn])
priceBondIrr AP.BuyBond {} [] = String -> Either String (Rate, [Txn])
forall a b. a -> Either a b
Left String
"No transaction to buy the bond" 
priceBondIrr (AP.HoldingBond HistoryCash
historyCash Balance
_ Maybe (Date, BondPricingMethod)
_) [] 
  = let 
      ([Date]
ds,[Balance]
vs) = HistoryCash -> ([Date], [Balance])
forall a b. [(a, b)] -> ([a], [b])
unzip HistoryCash
historyCash
      txns' :: [Txn]
txns' = [ Date
-> Balance
-> Balance
-> Balance
-> IRate
-> Balance
-> Balance
-> Balance
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
d Balance
0 Balance
0 Balance
0 IRate
0 Balance
v Balance
0 Balance
0 Maybe Float
forall a. Maybe a
Nothing TxnComment
Types.Empty | (Date
d,Balance
v) <- HistoryCash
historyCash ]
    in 
      do 
        Rate
irr <- [Date] -> [Balance] -> Either String Rate
Analytics.calcIRR [Date]
ds [Balance]
vs
        (Rate, [Txn]) -> Either String (Rate, [Txn])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rate
irr, [Txn]
txns')
-- Projected transaction and hold to maturity
priceBondIrr (AP.HoldingBond HistoryCash
historyCash Balance
holding Maybe (Date, BondPricingMethod)
Nothing) [Txn]
txns
  = let 
      begBal :: Balance
begBal = (Txn -> Balance
getTxnBegBalance (Txn -> Balance) -> ([Txn] -> Txn) -> [Txn] -> Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Txn] -> Txn
forall a. HasCallStack => [a] -> a
head) [Txn]
txns
      holdingPct :: Rate
holdingPct = Balance -> Balance -> Rate
divideBB Balance
holding Balance
begBal
      bProjectedTxn :: [Txn]
bProjectedTxn = Rate -> Txn -> Txn
scaleTxn Rate
holdingPct (Txn -> Txn) -> [Txn] -> [Txn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
txns -- `debug` ("holding pct"++ show holding ++"/" ++ show begBal ++" : " ++ show holdingPct)
      ([Date]
ds,[Balance]
vs) = HistoryCash -> ([Date], [Balance])
forall a b. [(a, b)] -> ([a], [b])
unzip HistoryCash
historyCash
      ([Date]
ds2,[Balance]
vs2) = (Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (Txn -> Date) -> [Txn] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
bProjectedTxn, Txn -> Balance
getTxnAmt (Txn -> Balance) -> [Txn] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
bProjectedTxn) -- `debug` ("projected txn position"++ show bProjectedTxn)
      
      txns' :: [Txn]
txns' = [ Date
-> Balance
-> Balance
-> Balance
-> IRate
-> Balance
-> Balance
-> Balance
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
d Balance
0 Balance
0 Balance
0 IRate
0 Balance
v Balance
0 Balance
0 Maybe Float
forall a. Maybe a
Nothing TxnComment
Types.Empty | (Date
d,Balance
v) <- HistoryCash
historyCash ]
    in 
      do 
        Rate
irr <- [Date] -> [Balance] -> Either String Rate
Analytics.calcIRR ([Date]
ds[Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++[Date]
ds2) ([Balance]
vs[Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++[Balance]
vs2) -- `debug` ("projected holding"++ show (ds2,vs2))
        (Rate, [Txn]) -> Either String (Rate, [Txn])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rate
irr, [Txn]
txns' [Txn] -> [Txn] -> [Txn]
forall a. [a] -> [a] -> [a]
++ [Txn]
bProjectedTxn)

-- TODO: need to use DC from bond
-- Projected transaction and sell at a Date
priceBondIrr (AP.HoldingBond HistoryCash
historyCash Balance
holding (Just (Date
sellDate, BondPricingMethod
sellPricingMethod))) [Txn]
txns
  = let 
      -- history cash
      ([Date]
ds,[Balance]
vs) = HistoryCash -> ([Date], [Balance])
forall a b. [(a, b)] -> ([a], [b])
unzip HistoryCash
historyCash
      txns' :: [Txn]
txns' = [ Date
-> Balance
-> Balance
-> Balance
-> IRate
-> Balance
-> Balance
-> Balance
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
d Balance
0 Balance
0 Balance
0 IRate
0 Balance
v Balance
0 Balance
0 Maybe Float
forall a. Maybe a
Nothing TxnComment
Types.Empty | (Date
d,Balance
v) <- HistoryCash
historyCash ]
      
      begBal :: Balance
begBal = (Txn -> Balance
getTxnBegBalance (Txn -> Balance) -> ([Txn] -> Txn) -> [Txn] -> Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Txn] -> Txn
forall a. HasCallStack => [a] -> a
head) [Txn]
txns
      holdingPct :: Rate
holdingPct = Balance -> Rate
forall a. Real a => a -> Rate
toRational (Balance -> Rate) -> Balance -> Rate
forall a b. (a -> b) -> a -> b
$ Balance
holding Balance -> Balance -> Balance
forall a. Fractional a => a -> a -> a
/ Balance
begBal
      -- assume cashflow of sell date belongs to seller(owner)
      ([Txn]
bProjectedTxn',[Txn]
futureFlow') = [Txn] -> Date -> SplitType -> ([Txn], [Txn])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [Txn]
txns Date
sellDate SplitType
EqToLeft
      ([Txn]
bProjectedTxn,[Txn]
futureFlow) = ((Rate -> Txn -> Txn
scaleTxn Rate
holdingPct) (Txn -> Txn) -> [Txn] -> [Txn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
bProjectedTxn',(Rate -> Txn -> Txn
scaleTxn Rate
holdingPct) (Txn -> Txn) -> [Txn] -> [Txn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
futureFlow')
      -- projected cash
      ([Date]
ds2,[Balance]
vs2) = (Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (Txn -> Date) -> [Txn] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
bProjectedTxn, Txn -> Balance
getTxnAmt (Txn -> Balance) -> [Txn] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
bProjectedTxn)
      -- accrued interest
      accruedInt :: Balance
accruedInt = Date -> Date -> [Txn] -> Balance
L.backoutAccruedInt Date
sellDate Date
epocDate ([Txn]
bProjectedTxn[Txn] -> [Txn] -> [Txn]
forall a. [a] -> [a] -> [a]
++[Txn]
futureFlow)
      (Date
ds3,Balance
vs3) = (Date
sellDate, Balance
accruedInt)  -- `debug` ("accrued interest"++ show (accruedInt,sellDate))
      -- sell price 
      sellPrice :: Balance
sellPrice = case BondPricingMethod
sellPricingMethod of 
                    BondBalanceFactor Rate
f -> case [Txn]
bProjectedTxn of 
                                            [] -> Balance -> Rate -> Balance
mulBR Balance
begBal (Rate
f Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate
holdingPct) 
                                            [Txn]
_txns -> Balance -> Rate -> Balance
mulBR (Txn -> Balance
getTxnBalance ([Txn] -> Txn
forall a. HasCallStack => [a] -> a
last [Txn]
_txns)) Rate
f
      (Date
ds4,Balance
vs4) = (Date
sellDate,  Balance
sellPrice)  -- `debug` ("sale price, date"++ show (sellPrice,sellDate))
    in 
      do 
        Rate
irr <- [Date] -> [Balance] -> Either String Rate
Analytics.calcIRR ([Date]
ds[Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++[Date]
ds2[Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++[Date
ds3][Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++[Date
ds4]) ([Balance]
vs[Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++[Balance]
vs2[Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++[Balance
vs3][Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++[Balance
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)
        (Rate, [Txn]) -> Either String (Rate, [Txn])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rate
irr, [Txn]
txns'[Txn] -> [Txn] -> [Txn]
forall a. [a] -> [a] -> [a]
++ [Txn]
bProjectedTxn[Txn] -> [Txn] -> [Txn]
forall a. [a] -> [a] -> [a]
++ [Date
-> Balance
-> Balance
-> Balance
-> IRate
-> Balance
-> Balance
-> Balance
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
sellDate Balance
0 Balance
vs3 Balance
sellPrice IRate
0 (Balance
sellPriceBalance -> Balance -> Balance
forall a. Num a => a -> a -> a
+Balance
vs3) Balance
0 Balance
0 Maybe Float
forall a. Maybe a
Nothing TxnComment
Types.Empty]) 

-- Buy and hold to maturity
priceBondIrr (AP.BuyBond Date
dateToBuy BondPricingMethod
bPricingMethod (AP.ByCash Balance
cash) Maybe (Date, BondPricingMethod)
Nothing) [Txn]
txns
  | [Txn] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Txn]
futureFlow' = String -> Either String (Rate, [Txn])
forall a b. a -> Either a b
Left String
"No transaction to buy bond"
  | Bool
otherwise
    = let 
      -- balance of bond on buy date
      nextTxn :: Txn
nextTxn = [Txn] -> Txn
forall a. HasCallStack => [a] -> a
head [Txn]
futureFlow'
      balAsBuyDate :: Balance
balAsBuyDate = Txn -> Balance
getTxnBegBalance Txn
nextTxn
      buyPrice :: Balance
buyPrice = case BondPricingMethod
bPricingMethod of 
                    BondBalanceFactor Rate
f -> Balance -> Rate -> Balance
mulBR Balance
balAsBuyDate Rate
f 
      buyPaidOut :: Balance
buyPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
buyPrice Balance
cash
      buyPct :: Rate
buyPct = Balance -> Balance -> Rate
divideBB Balance
buyPaidOut Balance
buyPrice
      boughtTxns :: [Txn]
boughtTxns = Rate -> Txn -> Txn
scaleTxn Rate
buyPct (Txn -> Txn) -> [Txn] -> [Txn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
futureFlow'
      -- buy price (including accrued interest)

      accuredInt :: Balance
accuredInt = let
                    --TODO what about interest over interest
                    accruedInt' :: Balance
accruedInt' = Balance -> Date -> Date -> IRate -> DayCount -> Balance
calcInt Balance
balAsBuyDate Date
dateToBuy (Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate Txn
nextTxn) (Txn -> IRate
getTxnRate Txn
nextTxn) DayCount
DC_ACT_365F
                    x :: Txn
x = Txn
nextTxn
                    totalInt' :: [Balance]
totalInt' = (Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe Balance
0) (Maybe Balance -> Balance) -> [Maybe Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Getting (First Balance) Txn Balance -> Txn -> Maybe Balance
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((Date, Balance, Balance, Balance, IRate, Balance, Balance,
  Balance, Maybe Float, TxnComment)
 -> Const
      (First Balance)
      (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
       Maybe Float, TxnComment))
-> Txn -> Const (First Balance) Txn
Prism'
  Txn
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
_BondTxn (((Date, Balance, Balance, Balance, IRate, Balance, Balance,
   Balance, Maybe Float, TxnComment)
  -> Const
       (First Balance)
       (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
        Maybe Float, TxnComment))
 -> Txn -> Const (First Balance) Txn)
-> ((Balance -> Const (First Balance) Balance)
    -> (Date, Balance, Balance, Balance, IRate, Balance, Balance,
        Balance, Maybe Float, TxnComment)
    -> Const
         (First Balance)
         (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
          Maybe Float, TxnComment))
-> Getting (First Balance) Txn Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Balance -> Const (First Balance) Balance)
-> (Date, Balance, Balance, Balance, IRate, Balance, Balance,
    Balance, Maybe Float, TxnComment)
-> Const
     (First Balance)
     (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
      Maybe Float, TxnComment)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
  Balance
  Balance
_3 ) Txn
x), (Getting (First Balance) Txn Balance -> Txn -> Maybe Balance
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((Date, Balance, Balance, Balance, IRate, Balance, Balance,
  Balance, Maybe Float, TxnComment)
 -> Const
      (First Balance)
      (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
       Maybe Float, TxnComment))
-> Txn -> Const (First Balance) Txn
Prism'
  Txn
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
_BondTxn (((Date, Balance, Balance, Balance, IRate, Balance, Balance,
   Balance, Maybe Float, TxnComment)
  -> Const
       (First Balance)
       (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
        Maybe Float, TxnComment))
 -> Txn -> Const (First Balance) Txn)
-> ((Balance -> Const (First Balance) Balance)
    -> (Date, Balance, Balance, Balance, IRate, Balance, Balance,
        Balance, Maybe Float, TxnComment)
    -> Const
         (First Balance)
         (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
          Maybe Float, TxnComment))
-> Getting (First Balance) Txn Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Balance -> Const (First Balance) Balance)
-> (Date, Balance, Balance, Balance, IRate, Balance, Balance,
    Balance, Maybe Float, TxnComment)
-> Const
     (First Balance)
     (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
      Maybe Float, TxnComment)
forall s t a b. Field7 s t a b => Lens s t a b
Lens
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
  Balance
  Balance
_7 ) Txn
x), (Getting (First Balance) Txn Balance -> Txn -> Maybe Balance
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((Date, Balance, Balance, Balance, IRate, Balance, Balance,
  Balance, Maybe Float, TxnComment)
 -> Const
      (First Balance)
      (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
       Maybe Float, TxnComment))
-> Txn -> Const (First Balance) Txn
Prism'
  Txn
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
_BondTxn (((Date, Balance, Balance, Balance, IRate, Balance, Balance,
   Balance, Maybe Float, TxnComment)
  -> Const
       (First Balance)
       (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
        Maybe Float, TxnComment))
 -> Txn -> Const (First Balance) Txn)
-> ((Balance -> Const (First Balance) Balance)
    -> (Date, Balance, Balance, Balance, IRate, Balance, Balance,
        Balance, Maybe Float, TxnComment)
    -> Const
         (First Balance)
         (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
          Maybe Float, TxnComment))
-> Getting (First Balance) Txn Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Balance -> Const (First Balance) Balance)
-> (Date, Balance, Balance, Balance, IRate, Balance, Balance,
    Balance, Maybe Float, TxnComment)
-> Const
     (First Balance)
     (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
      Maybe Float, TxnComment)
forall s t a b. Field8 s t a b => Lens s t a b
Lens
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
  (Date, Balance, Balance, Balance, IRate, Balance, Balance, Balance,
   Maybe Float, TxnComment)
  Balance
  Balance
_8 ) Txn
x)]
                   in
                    [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum([Balance]
totalInt') Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accruedInt'

      (Date
ds1, Balance
vs1) = (Date
dateToBuy, Balance -> Balance
forall a. Num a => a -> a
negate (Balance
buyPaidOut Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
accuredInt))
      ([Date]
ds2, [Balance]
vs2) = (Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (Txn -> Date) -> [Txn] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
futureFlow', Txn -> Balance
getTxnAmt (Txn -> Balance) -> [Txn] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
boughtTxns)
    in 
      do 
        Rate
irr <- [Date] -> [Balance] -> Either String Rate
Analytics.calcIRR (Date
ds1Date -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[Date]
ds2) (Balance
vs1Balance -> [Balance] -> [Balance]
forall a. a -> [a] -> [a]
:[Balance]
vs2)
        (Rate, [Txn]) -> Either String (Rate, [Txn])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rate
irr, (Date
-> Balance
-> Balance
-> Balance
-> IRate
-> Balance
-> Balance
-> Balance
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
dateToBuy Balance
0 (Balance -> Balance
forall a. Num a => a -> a
negate Balance
accuredInt) (Balance -> Balance
forall a. Num a => a -> a
negate Balance
buyPaidOut) IRate
0 Balance
vs1 Balance
0 Balance
0 Maybe Float
forall a. Maybe a
Nothing TxnComment
Types.Empty)Txn -> [Txn] -> [Txn]
forall a. a -> [a] -> [a]
:[Txn]
boughtTxns)
  where 
    -- assume cashflow of buy date belongs to seller(owner)
    ([Txn]
bProjectedTxn',[Txn]
futureFlow') = [Txn] -> Date -> SplitType -> ([Txn], [Txn])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [Txn]
txns Date
dateToBuy SplitType
EqToLeft


priceBonds :: Ast.Asset a => TestDeal a -> AP.BondPricingInput -> Either String (Map.Map String PriceResult)
-- Price bond via discount future cashflow
priceBonds :: forall a.
Asset a =>
TestDeal a
-> BondPricingInput -> Either String (Map String PriceResult)
priceBonds TestDeal a
t (AP.DiscountCurve Date
d Ts
dc) = Map String PriceResult -> Either String (Map String PriceResult)
forall a b. b -> Either a b
Right (Map String PriceResult -> Either String (Map String PriceResult))
-> Map String PriceResult -> Either String (Map String PriceResult)
forall a b. (a -> b) -> a -> b
$ (Bond -> PriceResult) -> Map String Bond -> Map String PriceResult
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Date -> Ts -> Bond -> PriceResult
L.priceBond Date
d Ts
dc) (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
viewBondsInMap TestDeal a
t)
-- Run Z-Spread
priceBonds t :: TestDeal a
t@TestDeal {bonds :: forall a. TestDeal a -> Map String Bond
bonds = Map String Bond
bndMap} (AP.RunZSpread Ts
curve Map String (Date, Rate)
bondPrices) 
  = Map String (Either String PriceResult)
-> Either String (Map String PriceResult)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map String (f a) -> f (Map String a)
sequenceA (Map String (Either String PriceResult)
 -> Either String (Map String PriceResult))
-> Map String (Either String PriceResult)
-> Either String (Map String PriceResult)
forall a b. (a -> b) -> a -> b
$ 
      (String -> (Date, Rate) -> Either String PriceResult)
-> Map String (Date, Rate)
-> Map String (Either String PriceResult)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
        (\String
bn (Date
pd,Rate
price)-> IRate -> PriceResult
ZSpread (IRate -> PriceResult)
-> Either String IRate -> Either String PriceResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rate, Date) -> Bond -> Ts -> Either String IRate
L.calcZspread (Rate
price,Date
pd) (Map String Bond
bndMap Map String Bond -> String -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! String
bn) Ts
curve)
        Map String (Date, Rate)
bondPrices
-- Calc Irr of bonds 
priceBonds t :: TestDeal a
t@TestDeal {bonds :: forall a. TestDeal a -> Map String Bond
bonds = Map String Bond
bndMap} (AP.IrrInput Map String IrrType
bMapInput) 
  = let
      -- Date 
      d :: Date
d = TestDeal a -> Date
forall a. SPV a => a -> Date
getNextBondPayDate TestDeal a
t
      -- get projected bond txn
      projectedTxns :: [Txn] -> [Txn]
projectedTxns [Txn]
xs = ([Txn], [Txn]) -> [Txn]
forall a b. (a, b) -> b
snd (([Txn], [Txn]) -> [Txn]) -> ([Txn], [Txn]) -> [Txn]
forall a b. (a -> b) -> a -> b
$ [Txn] -> Date -> SplitType -> ([Txn], [Txn])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [Txn]
xs Date
d SplitType
EqToRight 
      -- (Maybe Bond,IrrType)
      bndMap' :: Map String (Maybe Bond, IrrType)
bndMap' = (String -> IrrType -> (Maybe Bond, IrrType))
-> Map String IrrType -> Map String (Maybe Bond, IrrType)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\String
k IrrType
v -> (TestDeal a -> Bool -> String -> Maybe Bond
forall a. Asset a => TestDeal a -> Bool -> String -> Maybe Bond
getBondByName TestDeal a
t Bool
True String
k, IrrType
v)) Map String IrrType
bMapInput
      -- (Rate, [(date, cash)])
      bndMap'' :: Map String (Either String PriceResult)
bndMap'' = (String -> (Maybe Bond, IrrType) -> Either String PriceResult)
-> Map String (Maybe Bond, IrrType)
-> Map String (Either String PriceResult)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\String
bName (Just Bond
b, IrrType
v) -> 
                                  do 
                                    let _irrTxns :: [Txn]
_irrTxns = [Txn] -> [Txn]
projectedTxns (Bond -> [Txn]
forall a. HasStmt a => a -> [Txn]
getAllTxns Bond
b)
                                    (Rate
_irr, [Txn]
flows) <- IrrType -> [Txn] -> Either String (Rate, [Txn])
priceBondIrr IrrType
v [Txn]
_irrTxns
                                    PriceResult -> Either String PriceResult
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate -> [Txn] -> PriceResult
IrrResult (Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational Rate
_irr) [Txn]
flows))
                                Map String (Maybe Bond, IrrType)
bndMap'
    in 
      Map String (Either String PriceResult)
-> Either String (Map String PriceResult)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map String (f a) -> f (Map String a)
sequenceA Map String (Either String PriceResult)
bndMap''



-- <Legacy Test>, <Test on dates>

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 :: forall a.
Asset a =>
TestDeal a
-> Set ExpectReturn
-> Maybe ApplyAssumptionType
-> NonPerfAssumption
-> Either
     String
     (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
      Map String PriceResult, Map PoolId PoolCashflow)
runDeal TestDeal a
t Set ExpectReturn
er Maybe ApplyAssumptionType
perfAssumps nonPerfAssumps :: NonPerfAssumption
nonPerfAssumps@AP.NonPerfAssumption{callWhen :: NonPerfAssumption -> Maybe [CallOpt]
AP.callWhen = Maybe [CallOpt]
opts ,pricing :: NonPerfAssumption -> Maybe BondPricingInput
AP.pricing = Maybe BondPricingInput
mPricing ,revolving :: NonPerfAssumption -> Maybe RevolvingAssumption
AP.revolving = Maybe RevolvingAssumption
mRevolving ,interest :: NonPerfAssumption -> Maybe [RateAssumption]
AP.interest = Maybe [RateAssumption]
mInterest} 
  | Bool -> Bool
not Bool
runFlag = String
-> Either
     String
     (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
      Map String PriceResult, Map PoolId PoolCashflow)
forall a b. a -> Either a b
Left (String
 -> Either
      String
      (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
       Map String PriceResult, Map PoolId PoolCashflow))
-> String
-> Either
     String
     (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
      Map String PriceResult, Map PoolId PoolCashflow)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ResultComponent -> String
forall a. Show a => a -> String
show (ResultComponent -> String) -> [ResultComponent] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultComponent]
valLogs 
  | Bool
otherwise 
    = do 
        (TestDeal a
newT, [ActionOnDate]
ads, Map PoolId PoolCashflow
pcf, Map PoolId PoolCashflow
unStressPcf) <- Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     String
     (TestDeal a, [ActionOnDate], Map PoolId PoolCashflow,
      Map PoolId PoolCashflow)
forall a.
Asset a =>
Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     String
     (TestDeal a, [ActionOnDate], Map PoolId PoolCashflow,
      Map PoolId PoolCashflow)
getInits Set ExpectReturn
er TestDeal a
t Maybe ApplyAssumptionType
perfAssumps (NonPerfAssumption -> Maybe NonPerfAssumption
forall a. a -> Maybe a
Just NonPerfAssumption
nonPerfAssumps)  
        (TestDeal a
_finalDeal, DList ResultComponent
logs, Map PoolId PoolCashflow
osPoolFlow) <- TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run (TestDeal a -> TestDeal a
forall a. Asset a => TestDeal a -> TestDeal a
removePoolCf TestDeal a
newT) 
                                              Map PoolId PoolCashflow
pcf
                                              ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) 
                                              Maybe [RateAssumption]
mInterest
                                              ([CallOpt] -> ([Pre], [Pre])
AP.readCallOptions ([CallOpt] -> ([Pre], [Pre]))
-> Maybe [CallOpt] -> Maybe ([Pre], [Pre])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CallOpt]
opts)
                                              Maybe (Map String (RevolvingPool, ApplyAssumptionType))
mRevolvingCtx
                                              DList ResultComponent
forall a. DList a
DL.empty
	-- prepare deal with expected return
        let finalDeal :: TestDeal a
finalDeal = Set ExpectReturn -> TestDeal a -> TestDeal a
forall a. Asset a => Set ExpectReturn -> TestDeal a -> TestDeal a
prepareDeal Set ExpectReturn
er TestDeal a
_finalDeal
	-- extract pool cash collected to deal
        let poolFlowUsedNoEmpty :: Map PoolId CashFlowFrame
poolFlowUsedNoEmpty = (CashFlowFrame -> CashFlowFrame)
-> Map PoolId CashFlowFrame -> Map PoolId CashFlowFrame
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
	                            (ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn [TsRow] -> [TsRow]
CF.dropTailEmptyTxns) 
	                            (TestDeal a -> Maybe [PoolId] -> Map PoolId CashFlowFrame
forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId CashFlowFrame
getAllCollectedFrame TestDeal a
finalDeal Maybe [PoolId]
forall a. Maybe a
Nothing)
        let poolFlowUnUsed :: Map PoolId PoolCashflow
poolFlowUnUsed = Map PoolId PoolCashflow
osPoolFlow Map PoolId PoolCashflow
-> (Map PoolId PoolCashflow -> Map PoolId PoolCashflow)
-> Map PoolId PoolCashflow
forall a b. a -> (a -> b) -> b
& (PoolCashflow -> Identity PoolCashflow)
-> Map PoolId PoolCashflow -> Identity (Map PoolId PoolCashflow)
Setter
  (Map PoolId PoolCashflow)
  (Map PoolId PoolCashflow)
  PoolCashflow
  PoolCashflow
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((PoolCashflow -> Identity PoolCashflow)
 -> Map PoolId PoolCashflow -> Identity (Map PoolId PoolCashflow))
-> (([TsRow] -> Identity [TsRow])
    -> PoolCashflow -> Identity PoolCashflow)
-> ([TsRow] -> Identity [TsRow])
-> Map PoolId PoolCashflow
-> Identity (Map PoolId PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Identity CashFlowFrame)
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1 ((CashFlowFrame -> Identity CashFlowFrame)
 -> PoolCashflow -> Identity PoolCashflow)
-> ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ([TsRow] -> Identity [TsRow])
-> PoolCashflow
-> Identity PoolCashflow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn (([TsRow] -> Identity [TsRow])
 -> Map PoolId PoolCashflow -> Identity (Map PoolId PoolCashflow))
-> ([TsRow] -> [TsRow])
-> Map PoolId PoolCashflow
-> Map PoolId PoolCashflow
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [TsRow] -> [TsRow]
CF.dropTailEmptyTxns
		                        Map PoolId PoolCashflow
-> (Map PoolId PoolCashflow -> Map PoolId PoolCashflow)
-> Map PoolId PoolCashflow
forall a b. a -> (a -> b) -> b
& (PoolCashflow -> Identity PoolCashflow)
-> Map PoolId PoolCashflow -> Identity (Map PoolId PoolCashflow)
Setter
  (Map PoolId PoolCashflow)
  (Map PoolId PoolCashflow)
  PoolCashflow
  PoolCashflow
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((PoolCashflow -> Identity PoolCashflow)
 -> Map PoolId PoolCashflow -> Identity (Map PoolId PoolCashflow))
-> (([TsRow] -> Identity [TsRow])
    -> PoolCashflow -> Identity PoolCashflow)
-> ([TsRow] -> Identity [TsRow])
-> Map PoolId PoolCashflow
-> Identity (Map PoolId PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  PoolCashflow
  PoolCashflow
  (Maybe [CashFlowFrame])
  (Maybe [CashFlowFrame])
_2 ((Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
 -> PoolCashflow -> Identity PoolCashflow)
-> (([TsRow] -> Identity [TsRow])
    -> Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
-> ([TsRow] -> Identity [TsRow])
-> PoolCashflow
-> Identity PoolCashflow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CashFlowFrame] -> Identity [CashFlowFrame])
-> Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame])
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (([CashFlowFrame] -> Identity [CashFlowFrame])
 -> Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
-> (([TsRow] -> Identity [TsRow])
    -> [CashFlowFrame] -> Identity [CashFlowFrame])
-> ([TsRow] -> Identity [TsRow])
-> Maybe [CashFlowFrame]
-> Identity (Maybe [CashFlowFrame])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Identity CashFlowFrame)
-> [CashFlowFrame] -> Identity [CashFlowFrame]
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  [CashFlowFrame] [CashFlowFrame] CashFlowFrame CashFlowFrame
each ((CashFlowFrame -> Identity CashFlowFrame)
 -> [CashFlowFrame] -> Identity [CashFlowFrame])
-> ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ([TsRow] -> Identity [TsRow])
-> [CashFlowFrame]
-> Identity [CashFlowFrame]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn (([TsRow] -> Identity [TsRow])
 -> Map PoolId PoolCashflow -> Identity (Map PoolId PoolCashflow))
-> ([TsRow] -> [TsRow])
-> Map PoolId PoolCashflow
-> Map PoolId PoolCashflow
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [TsRow] -> [TsRow]
CF.dropTailEmptyTxns
        Map String PriceResult
bndPricing <- case Maybe BondPricingInput
mPricing of 
                        (Just BondPricingInput
p) -> TestDeal a
-> BondPricingInput -> Either String (Map String PriceResult)
forall a.
Asset a =>
TestDeal a
-> BondPricingInput -> Either String (Map String PriceResult)
priceBonds TestDeal a
finalDeal BondPricingInput
p 
                        Maybe BondPricingInput
Nothing -> Map String PriceResult -> Either String (Map String PriceResult)
forall a b. b -> Either a b
Right Map String PriceResult
forall k a. Map k a
Map.empty
        (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
 Map String PriceResult, Map PoolId PoolCashflow)
-> Either
     String
     (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
      Map String PriceResult, Map PoolId PoolCashflow)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
finalDeal
                 , Map PoolId CashFlowFrame
poolFlowUsedNoEmpty
                 , TestDeal a -> [ResultComponent]
forall a. Asset a => TestDeal a -> [ResultComponent]
getRunResult TestDeal a
finalDeal [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ TestDeal a -> [ResultComponent]
forall a. TestDeal a -> [ResultComponent]
V.validateRun TestDeal a
finalDeal [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ DList ResultComponent -> [ResultComponent]
forall a. DList a -> [a]
DL.toList (DList ResultComponent
-> DList ResultComponent -> DList ResultComponent
forall a. DList a -> DList a -> DList a
DL.append DList ResultComponent
logs (Map PoolId PoolCashflow -> DList ResultComponent
forall {s} {k}.
(Field1 s s CashFlowFrame CashFlowFrame, Show k) =>
Map k s -> DList ResultComponent
unCollectedPoolFlowWarning Map PoolId PoolCashflow
poolFlowUnUsed))
		 , Map String PriceResult
bndPricing
	         , Map PoolId PoolCashflow
poolFlowUnUsed
	       ) -- `debug` ("run deal done with pool" ++ show poolFlowUsedNoEmpty)
    where
      (Bool
runFlag, [ResultComponent]
valLogs) = TestDeal a -> NonPerfAssumption -> (Bool, [ResultComponent])
forall a.
(UseRate a, Asset a) =>
TestDeal a -> NonPerfAssumption -> (Bool, [ResultComponent])
V.validateReq TestDeal a
t NonPerfAssumption
nonPerfAssumps 
      -- getinits() will get (new deal snapshot, actions, pool cashflows, unstressed pool cashflow)
      -- extract Revolving Assumption
      mRevolvingCtx :: Maybe (Map String (RevolvingPool, ApplyAssumptionType))
mRevolvingCtx = case Maybe RevolvingAssumption
mRevolving of
                        Maybe RevolvingAssumption
Nothing -> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
forall a. Maybe a
Nothing
                        Just (AP.AvailableAssets RevolvingPool
rp ApplyAssumptionType
rperf) -> Map String (RevolvingPool, ApplyAssumptionType)
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
forall a. a -> Maybe a
Just ([(String, (RevolvingPool, ApplyAssumptionType))]
-> Map String (RevolvingPool, ApplyAssumptionType)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"Consol", (RevolvingPool
rp, ApplyAssumptionType
rperf))])
                        Just (AP.AvailableAssetsBy Map String (RevolvingPool, ApplyAssumptionType)
rMap) -> Map String (RevolvingPool, ApplyAssumptionType)
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
forall a. a -> Maybe a
Just Map String (RevolvingPool, ApplyAssumptionType)
rMap
      unCollectedPoolFlowWarning :: Map k s -> DList ResultComponent
unCollectedPoolFlowWarning Map k s
pMap = let
                                           countMap :: Map k Int
countMap = (s -> Int) -> Map k s -> Map k Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (CashFlowFrame -> Int
CF.sizeCashFlowFrame (CashFlowFrame -> Int) -> (s -> CashFlowFrame) -> s -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CashFlowFrame s CashFlowFrame -> s -> CashFlowFrame
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CashFlowFrame s CashFlowFrame
forall s t a b. Field1 s t a b => Lens s t a b
Lens s s CashFlowFrame CashFlowFrame
_1) Map k s
pMap 
                                        in 
					  if [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Map k Int -> [Int]
forall k a. Map k a -> [a]
Map.elems Map k Int
countMap) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then 
                                          ResultComponent -> DList ResultComponent
forall a. a -> DList a
DL.singleton (ResultComponent -> DList ResultComponent)
-> ResultComponent -> DList ResultComponent
forall a b. (a -> b) -> a -> b
$ String -> ResultComponent
WarningMsg (String -> ResultComponent) -> String -> ResultComponent
forall a b. (a -> b) -> a -> b
$ String
"Oustanding pool cashflow hasn't been collected yet"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Map k Int -> String
forall a. Show a => a -> String
show Map k Int
countMap
                                        else
					  DList ResultComponent
forall a. DList a
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 :: forall a. Asset a => TestDeal a -> [ResultComponent]
getRunResult TestDeal a
t = [ResultComponent]
os_bn_i [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
os_bn_b -- `debug` ("Done with get result")
  where 
    bs :: [Bond]
bs = TestDeal a -> [Bond]
forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
t  
    os_bn_b :: [ResultComponent]
os_bn_b = [ String -> Balance -> Balance -> ResultComponent
BondOutstanding (Bond -> String
L.bndName Bond
_b) (Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getCurBalance Bond
_b) (TestDeal a -> String -> Balance
forall a. SPV a => a -> String -> Balance
getBondBegBal TestDeal a
t (Bond -> String
L.bndName Bond
_b)) | Bond
_b <- [Bond]
bs ] -- `debug` ("B"++ show bs)
    os_bn_i :: [ResultComponent]
os_bn_i = [ String -> Balance -> Balance -> ResultComponent
BondOutstandingInt (Bond -> String
L.bndName Bond
_b) (Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt Bond
_b) (TestDeal a -> String -> Balance
forall a. SPV a => a -> String -> Balance
getBondBegBal TestDeal a
t (Bond -> String
L.bndName Bond
_b)) | Bond
_b <- [Bond]
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 :: forall a. Asset a => Set ExpectReturn -> TestDeal a -> TestDeal a
prepareDeal Set ExpectReturn
er t :: TestDeal a
t@TestDeal {bonds :: forall a. TestDeal a -> Map String Bond
bonds = Map String Bond
bndMap ,pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
poolType } 
  = let 
      consolePoolFlowFn :: CashFlowFrame -> CashFlowFrame
consolePoolFlowFn = ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn [TsRow] -> [TsRow]
CF.dropTailEmptyTxns
      rmAssetLevelFn :: [CashFlowFrame] -> [CashFlowFrame]
rmAssetLevelFn [CashFlowFrame]
xs 
        | ExpectReturn -> Set ExpectReturn -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ExpectReturn
AssetLevelFlow Set ExpectReturn
er = [CashFlowFrame]
xs
	| Bool
otherwise = []
    in 
      TestDeal a
t {bonds = Map.map (L.patchBondFactor . L.consolStmt) bndMap
	 ,pool = poolType & over (_MultiPool . mapped . P.poolFutureCf . _Just ._1) consolePoolFlowFn 
	                  & over (_ResecDeal . mapped . uDealFutureCf . _Just) consolePoolFlowFn
			  & over (_MultiPool . mapped . P.poolFutureCf . _Just . _2 . _Just) rmAssetLevelFn 
	}


-- ^ emtpy deal's pool cashflow
removePoolCf :: Ast.Asset a => TestDeal a -> TestDeal a
removePoolCf :: forall a. Asset a => TestDeal a -> TestDeal a
removePoolCf t :: TestDeal a
t@TestDeal{pool :: forall a. TestDeal a -> PoolType a
pool=PoolType a
pt} =
  let 
    newPt :: PoolType a
newPt = case PoolType a
pt of 
              MultiPool Map PoolId (Pool a)
pm -> Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool (Map PoolId (Pool a) -> PoolType a)
-> Map PoolId (Pool a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ ASetter
  (Map PoolId (Pool a))
  (Map PoolId (Pool a))
  (Maybe PoolCashflow)
  (Maybe PoolCashflow)
-> Maybe PoolCashflow -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Pool a -> Identity (Pool a))
-> Map PoolId (Pool a) -> Identity (Map PoolId (Pool a))
Setter
  (Map PoolId (Pool a)) (Map PoolId (Pool a)) (Pool a) (Pool a)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((Pool a -> Identity (Pool a))
 -> Map PoolId (Pool a) -> Identity (Map PoolId (Pool a)))
-> ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
    -> Pool a -> Identity (Pool a))
-> ASetter
     (Map PoolId (Pool a))
     (Map PoolId (Pool a))
     (Maybe PoolCashflow)
     (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> Pool a -> Identity (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureCf) Maybe PoolCashflow
forall a. Maybe a
Nothing Map PoolId (Pool a)
pm 
              ResecDeal Map PoolId (UnderlyingDeal a)
uds -> Map PoolId (UnderlyingDeal a) -> PoolType a
forall a. Map PoolId (UnderlyingDeal a) -> PoolType a
ResecDeal Map PoolId (UnderlyingDeal a)
uds
  in
    TestDeal a
t {pool = newPt}

runPoolType :: Ast.Asset a => Bool -> PoolType a -> Maybe AP.ApplyAssumptionType 
            -> Maybe AP.NonPerfAssumption -> Either String (Map.Map PoolId CF.PoolCashflow)

runPoolType :: forall a.
Asset a =>
Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either String (Map PoolId PoolCashflow)
runPoolType Bool
flag (MultiPool Map PoolId (Pool a)
pm) (Just ApplyAssumptionType
poolAssumpType) Maybe NonPerfAssumption
mNonPerfAssump
  = let 
      rateAssump :: Maybe [RateAssumption]
rateAssump = NonPerfAssumption -> Maybe [RateAssumption]
AP.interest (NonPerfAssumption -> Maybe [RateAssumption])
-> Maybe NonPerfAssumption -> Maybe [RateAssumption]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe NonPerfAssumption
mNonPerfAssump
      calcPoolCashflow :: ApplyAssumptionType
-> PoolId
-> Pool a
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
calcPoolCashflow (AP.ByName Map PoolId AssetPerf
assumpMap) PoolId
pid Pool a
v = Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
P.runPool Pool a
v (AssetPerf -> ApplyAssumptionType
AP.PoolLevel (AssetPerf -> ApplyAssumptionType)
-> Maybe AssetPerf -> Maybe ApplyAssumptionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PoolId -> Map PoolId AssetPerf -> Maybe AssetPerf
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PoolId
pid Map PoolId AssetPerf
assumpMap) Maybe [RateAssumption]
rateAssump 	
      calcPoolCashflow (AP.ByPoolId Map PoolId ApplyAssumptionType
assumpMap) PoolId
pid Pool a
v = Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
P.runPool Pool a
v (PoolId
-> Map PoolId ApplyAssumptionType -> Maybe ApplyAssumptionType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PoolId
pid Map PoolId ApplyAssumptionType
assumpMap) Maybe [RateAssumption]
rateAssump
      calcPoolCashflow ApplyAssumptionType
poolAssump PoolId
pid Pool a
v = Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
P.runPool Pool a
v (ApplyAssumptionType -> Maybe ApplyAssumptionType
forall a. a -> Maybe a
Just ApplyAssumptionType
poolAssump) Maybe [RateAssumption]
rateAssump
    in
      Map PoolId (Either String PoolCashflow)
-> Either String (Map PoolId PoolCashflow)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map PoolId (f a) -> f (Map PoolId a)
sequenceA (Map PoolId (Either String PoolCashflow)
 -> Either String (Map PoolId PoolCashflow))
-> Map PoolId (Either String PoolCashflow)
-> Either String (Map PoolId PoolCashflow)
forall a b. (a -> b) -> a -> b
$
        (PoolId -> Pool a -> Either String PoolCashflow)
-> Map PoolId (Pool a) -> Map PoolId (Either String PoolCashflow)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
          (\PoolId
k Pool a
v -> 
            let 
              poolBegStats :: Maybe (Map CutoffFields Balance)
poolBegStats = Pool a -> Maybe (Map CutoffFields Balance)
forall a. Pool a -> Maybe (Map CutoffFields Balance)
P.issuanceStat Pool a
v
            in
	      do 
                [(CashFlowFrame, Map CutoffFields Balance)]
assetCfs <- ApplyAssumptionType
-> PoolId
-> Pool a
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
calcPoolCashflow ApplyAssumptionType
poolAssumpType PoolId
k Pool a
v
                let (CashFlowFrame
poolCf,Map CutoffFields Balance
_) = Maybe (Map CutoffFields Balance)
-> [(CashFlowFrame, Map CutoffFields Balance)]
-> (CashFlowFrame, Map CutoffFields Balance)
P.aggPool Maybe (Map CutoffFields Balance)
poolBegStats [(CashFlowFrame, Map CutoffFields Balance)]
assetCfs
                PoolCashflow -> Either String PoolCashflow
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (CashFlowFrame
poolCf, if Bool
flag then 
				   [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a. a -> Maybe a
Just ([CashFlowFrame] -> Maybe [CashFlowFrame])
-> [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a b. (a -> b) -> a -> b
$ (CashFlowFrame, Map CutoffFields Balance) -> CashFlowFrame
forall a b. (a, b) -> a
fst ((CashFlowFrame, Map CutoffFields Balance) -> CashFlowFrame)
-> [(CashFlowFrame, Map CutoffFields Balance)] -> [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(CashFlowFrame, Map CutoffFields Balance)]
assetCfs
		                 else
		                   Maybe [CashFlowFrame]
forall a. Maybe a
Nothing))
  	  Map PoolId (Pool a)
pm

runPoolType Bool
flag (MultiPool Map PoolId (Pool a)
pm) Maybe ApplyAssumptionType
mAssumps Maybe NonPerfAssumption
mNonPerfAssump
  = Map PoolId (Either String PoolCashflow)
-> Either String (Map PoolId PoolCashflow)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map PoolId (f a) -> f (Map PoolId a)
sequenceA (Map PoolId (Either String PoolCashflow)
 -> Either String (Map PoolId PoolCashflow))
-> Map PoolId (Either String PoolCashflow)
-> Either String (Map PoolId PoolCashflow)
forall a b. (a -> b) -> a -> b
$ 
      (Pool a -> Either String PoolCashflow)
-> Map PoolId (Pool a) -> Map PoolId (Either String PoolCashflow)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Pool a
p -> 
		do
		  [(CashFlowFrame, Map CutoffFields Balance)]
assetFlows <- Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either String [(CashFlowFrame, Map CutoffFields Balance)]
P.runPool Pool a
p Maybe ApplyAssumptionType
mAssumps (NonPerfAssumption -> Maybe [RateAssumption]
AP.interest (NonPerfAssumption -> Maybe [RateAssumption])
-> Maybe NonPerfAssumption -> Maybe [RateAssumption]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe NonPerfAssumption
mNonPerfAssump)
		  let (CashFlowFrame
poolCf, Map CutoffFields Balance
poolStatMap) = Maybe (Map CutoffFields Balance)
-> [(CashFlowFrame, Map CutoffFields Balance)]
-> (CashFlowFrame, Map CutoffFields Balance)
P.aggPool (Pool a -> Maybe (Map CutoffFields Balance)
forall a. Pool a -> Maybe (Map CutoffFields Balance)
P.issuanceStat Pool a
p) [(CashFlowFrame, Map CutoffFields Balance)]
assetFlows
		  PoolCashflow -> Either String PoolCashflow
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (CashFlowFrame
poolCf, if Bool
flag then 
				     [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a. a -> Maybe a
Just ([CashFlowFrame] -> Maybe [CashFlowFrame])
-> [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a b. (a -> b) -> a -> b
$ (CashFlowFrame, Map CutoffFields Balance) -> CashFlowFrame
forall a b. (a, b) -> a
fst ((CashFlowFrame, Map CutoffFields Balance) -> CashFlowFrame)
-> [(CashFlowFrame, Map CutoffFields Balance)] -> [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(CashFlowFrame, Map CutoffFields Balance)]
assetFlows
	    		           else
		                     Maybe [CashFlowFrame]
forall a. Maybe a
Nothing))
              Map PoolId (Pool a)
pm

runPoolType Bool
flag (ResecDeal Map PoolId (UnderlyingDeal a)
dm) Maybe ApplyAssumptionType
mAssumps Maybe NonPerfAssumption
mNonPerfAssump
  = 
    let 
      assumpMap :: Map
  PoolId (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
assumpMap =  (PoolId
 -> UnderlyingDeal a
 -> (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption)))
-> Map PoolId (UnderlyingDeal a)
-> Map
     PoolId (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\PoolId
_ (UnderlyingDeal TestDeal a
uDeal Maybe CashFlowFrame
_ Maybe CashFlowFrame
_ Maybe (Map CutoffFields Balance)
_) -> 
                              let 
                                 dName :: String
dName = TestDeal a -> String
forall a. TestDeal a -> String
name TestDeal a
uDeal -- `debug` ("Getting name of underlying deal:"++ (name uDeal))
                                 mAssump :: Maybe (ApplyAssumptionType, NonPerfAssumption)
mAssump = case Maybe ApplyAssumptionType
mAssumps of 
                                             Just (AP.ByDealName Map String (ApplyAssumptionType, NonPerfAssumption)
assumpMap) -> String
-> Map String (ApplyAssumptionType, NonPerfAssumption)
-> Maybe (ApplyAssumptionType, NonPerfAssumption)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
dName Map String (ApplyAssumptionType, NonPerfAssumption)
assumpMap
                                             Maybe ApplyAssumptionType
_ -> Maybe (ApplyAssumptionType, NonPerfAssumption)
forall a. Maybe a
Nothing
                               in 
                                 (TestDeal a
uDeal, Maybe (ApplyAssumptionType, NonPerfAssumption)
mAssump))
                             Map PoolId (UnderlyingDeal a)
dm
      ranMap :: Map PoolId (Either String PoolCashflow)
ranMap =   (PoolId
 -> (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
 -> Either String PoolCashflow)
-> Map
     PoolId (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
-> Map PoolId (Either String PoolCashflow)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\(DealBondFlow String
dn String
bn Date
sd Rate
pct) (TestDeal a
uDeal, Maybe (ApplyAssumptionType, NonPerfAssumption)
mAssump) -> 
                                  let
                                    (Maybe ApplyAssumptionType
poolAssump,NonPerfAssumption
dealAssump) = case Maybe (ApplyAssumptionType, NonPerfAssumption)
mAssump of 
                                                                Maybe (ApplyAssumptionType, NonPerfAssumption)
Nothing -> (Maybe ApplyAssumptionType
forall a. Maybe a
Nothing, Maybe StopBy
-> Maybe [(String, Ts)]
-> Maybe [CallOpt]
-> Maybe RevolvingAssumption
-> Maybe [RateAssumption]
-> Maybe [InspectType]
-> Maybe DatePattern
-> Maybe BondPricingInput
-> Maybe [(Date, DealCycle, String)]
-> Maybe (Date, IRate, Table Float IRate)
-> Maybe [TsPoint IssueBondEvent]
-> Maybe [TsPoint RefiEvent]
-> NonPerfAssumption
AP.NonPerfAssumption Maybe StopBy
forall a. Maybe a
Nothing Maybe [(String, Ts)]
forall a. Maybe a
Nothing Maybe [CallOpt]
forall a. Maybe a
Nothing Maybe RevolvingAssumption
forall a. Maybe a
Nothing Maybe [RateAssumption]
forall a. Maybe a
Nothing Maybe [InspectType]
forall a. Maybe a
Nothing Maybe DatePattern
forall a. Maybe a
Nothing Maybe BondPricingInput
forall a. Maybe a
Nothing Maybe [(Date, DealCycle, String)]
forall a. Maybe a
Nothing Maybe (Date, IRate, Table Float IRate)
forall a. Maybe a
Nothing Maybe [TsPoint IssueBondEvent]
forall a. Maybe a
Nothing Maybe [TsPoint RefiEvent]
forall a. Maybe a
Nothing)
                                                                Just (ApplyAssumptionType
_poolAssump, NonPerfAssumption
_dealAssump) -> (ApplyAssumptionType -> Maybe ApplyAssumptionType
forall a. a -> Maybe a
Just ApplyAssumptionType
_poolAssump, NonPerfAssumption
_dealAssump)
                                  in
                                    do 
                                      (TestDeal a
dealRunned, Map PoolId CashFlowFrame
_, [ResultComponent]
_, Map String PriceResult
_,Map PoolId PoolCashflow
_) <- TestDeal a
-> Set ExpectReturn
-> Maybe ApplyAssumptionType
-> NonPerfAssumption
-> Either
     String
     (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
      Map String PriceResult, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Set ExpectReturn
-> Maybe ApplyAssumptionType
-> NonPerfAssumption
-> Either
     String
     (TestDeal a, Map PoolId CashFlowFrame, [ResultComponent],
      Map String PriceResult, Map PoolId PoolCashflow)
runDeal TestDeal a
uDeal ([ExpectReturn] -> Set ExpectReturn
forall a. Ord a => [a] -> Set a
S.fromList []) Maybe ApplyAssumptionType
poolAssump NonPerfAssumption
dealAssump
                                      let bondFlow :: [Txn]
bondFlow = CutoffType -> DateDirection -> Date -> [Txn] -> [Txn]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Inc DateDirection
Future Date
sd ([Txn] -> [Txn]) -> [Txn] -> [Txn]
forall a b. (a -> b) -> a -> b
$ [[Txn]] -> [Txn]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Txn]] -> [Txn]) -> [[Txn]] -> [Txn]
forall a b. (a -> b) -> a -> b
$ Map String [Txn] -> [[Txn]]
forall k a. Map k a -> [a]
Map.elems (Map String [Txn] -> [[Txn]]) -> Map String [Txn] -> [[Txn]]
forall a b. (a -> b) -> a -> b
$ (Maybe Statement -> [Txn])
-> Map String (Maybe Statement) -> Map String [Txn]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList (DList Txn -> [Txn])
-> (Maybe Statement -> DList Txn) -> Maybe Statement -> [Txn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Statement -> DList Txn
Stmt.getTxns) (Map String (Maybe Statement) -> Map String [Txn])
-> Map String (Maybe Statement) -> Map String [Txn]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Maybe [String] -> Map String (Maybe Statement)
forall a.
SPV a =>
a -> Maybe [String] -> Map String (Maybe Statement)
getBondStmtByName TestDeal a
dealRunned ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
bn]) 
                                      let bondFlowRated :: [TsRow]
bondFlowRated = (\(BondTxn Date
d Balance
b Balance
i Balance
p IRate
r Balance
c Balance
di Balance
dioi Maybe Float
f TxnComment
t) -> Date -> Balance -> Balance -> Balance -> TsRow
CF.BondFlow Date
d Balance
b Balance
p Balance
i) (Txn -> TsRow) -> [Txn] -> [TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rate -> [Txn] -> [Txn]
Stmt.scaleByFactor Rate
pct [Txn]
bondFlow 
                                      PoolCashflow -> Either String PoolCashflow
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Balance
0,Date
sd,Maybe Balance
forall a. Maybe a
Nothing) [TsRow]
bondFlowRated, Maybe [CashFlowFrame]
forall a. Maybe a
Nothing))
                                 Map
  PoolId (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
assumpMap
    in
      Map PoolId (Either String PoolCashflow)
-> Either String (Map PoolId PoolCashflow)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map PoolId (f a) -> f (Map PoolId a)
sequenceA Map PoolId (Either String PoolCashflow)
ranMap
 

-- ^ 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 :: forall a.
Asset a =>
DealStatus -> Map PoolId Balance -> PoolType a -> PoolType a
patchIssuanceBalance (PreClosing DealStatus
_ ) Map PoolId Balance
balM PoolType a
pt =
  case PoolType a
pt of 
    MultiPool Map PoolId (Pool a)
pM -> Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool (Map PoolId (Pool a) -> PoolType a)
-> Map PoolId (Pool a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ (PoolId -> Pool a -> Pool a)
-> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
    				  (\PoolId
k Pool a
v -> ASetter
  (Pool a)
  (Pool a)
  (Map CutoffFields Balance)
  (Map CutoffFields Balance)
-> (Map CutoffFields Balance -> Map CutoffFields Balance)
-> Pool a
-> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Pool a)
  (Pool a)
  (Map CutoffFields Balance)
  (Map CutoffFields Balance)
forall a. Asset a => Lens' (Pool a) (Map CutoffFields Balance)
Lens' (Pool a) (Map CutoffFields Balance)
P.poolIssuanceStat (CutoffFields
-> Balance -> Map CutoffFields Balance -> Map CutoffFields Balance
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CutoffFields
IssuanceBalance (Balance -> PoolId -> Map PoolId Balance -> Balance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Balance
0.0 PoolId
k Map PoolId Balance
balM)) Pool a
v)
				  Map PoolId (Pool a)
pM
    ResecDeal Map PoolId (UnderlyingDeal a)
pM -> Map PoolId (UnderlyingDeal a) -> PoolType a
forall a. Map PoolId (UnderlyingDeal a) -> PoolType a
ResecDeal Map PoolId (UnderlyingDeal a)
pM  --TODO patch balance for resec deal
    
patchIssuanceBalance DealStatus
_ Map PoolId Balance
bal PoolType a
p = PoolType a
p -- `debug` ("NO patching ?")


patchScheduleFlow :: Ast.Asset a => Map.Map PoolId CF.PoolCashflow -> PoolType a -> PoolType a
patchScheduleFlow :: forall a.
Asset a =>
Map PoolId PoolCashflow -> PoolType a -> PoolType a
patchScheduleFlow Map PoolId PoolCashflow
flowM PoolType a
pt = 
  case PoolType a
pt of
    MultiPool Map PoolId (Pool a)
pM -> Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool (Map PoolId (Pool a) -> PoolType a)
-> Map PoolId (Pool a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ (PoolCashflow -> Pool a -> Pool a)
-> Map PoolId PoolCashflow
-> Map PoolId (Pool a)
-> Map PoolId (Pool a)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (ASetter (Pool a) (Pool a) PoolCashflow PoolCashflow
-> PoolCashflow -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> Pool a -> Identity (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureScheduleCf ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
 -> Pool a -> Identity (Pool a))
-> ((PoolCashflow -> Identity PoolCashflow)
    -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ASetter (Pool a) (Pool a) PoolCashflow PoolCashflow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Identity PoolCashflow)
-> Maybe PoolCashflow -> Identity (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just)) Map PoolId PoolCashflow
flowM Map PoolId (Pool a)
pM
    ResecDeal Map PoolId (UnderlyingDeal a)
pM -> Map PoolId (UnderlyingDeal a) -> PoolType a
forall a. Map PoolId (UnderlyingDeal a) -> PoolType a
ResecDeal Map PoolId (UnderlyingDeal a)
pM

patchRuntimeBal :: Ast.Asset a => Map.Map PoolId Balance -> PoolType a -> PoolType a
patchRuntimeBal :: forall a. Asset a => Map PoolId Balance -> PoolType a -> PoolType a
patchRuntimeBal Map PoolId Balance
balMap (MultiPool Map PoolId (Pool a)
pM) 
  = Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool (Map PoolId (Pool a) -> PoolType a)
-> Map PoolId (Pool a) -> PoolType a
forall a b. (a -> b) -> a -> b
$
      (PoolId -> Pool a -> Pool a)
-> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
        (\PoolId
k Pool a
p -> ASetter
  (Pool a)
  (Pool a)
  (Map CutoffFields Balance)
  (Map CutoffFields Balance)
-> (Map CutoffFields Balance -> Map CutoffFields Balance)
-> Pool a
-> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Pool a)
  (Pool a)
  (Map CutoffFields Balance)
  (Map CutoffFields Balance)
forall a. Asset a => Lens' (Pool a) (Map CutoffFields Balance)
Lens' (Pool a) (Map CutoffFields Balance)
P.poolIssuanceStat 
                      (CutoffFields
-> Balance -> Map CutoffFields Balance -> Map CutoffFields Balance
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CutoffFields
RuntimeCurrentPoolBalance (Balance -> PoolId -> Map PoolId Balance -> Balance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Balance
0.0 PoolId
k Map PoolId Balance
balMap)) 
                      Pool a
p)
        Map PoolId (Pool a)
pM

patchRuntimeBal Map PoolId Balance
balMap PoolType a
pt = PoolType a
pt


   

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 :: forall a.
Asset a =>
Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     String
     (TestDeal a, [ActionOnDate], Map PoolId PoolCashflow,
      Map PoolId PoolCashflow)
getInits Set ExpectReturn
er t :: TestDeal a
t@TestDeal{fees :: forall a. TestDeal a -> Map String Fee
fees=Map String Fee
feeMap,pool :: forall a. TestDeal a -> PoolType a
pool=PoolType a
thePool,status :: forall a. TestDeal a -> DealStatus
status=DealStatus
status,bonds :: forall a. TestDeal a -> Map String Bond
bonds=Map String Bond
bndMap,stats :: forall a.
TestDeal a
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
stats=(BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
_stats} Maybe ApplyAssumptionType
mAssumps Maybe NonPerfAssumption
mNonPerfAssump =
  let 
    expandInspect :: Date -> Date -> InspectType -> [ActionOnDate]
expandInspect Date
sd Date
ed (AP.InspectPt DatePattern
dp DealStats
ds) = [ Date -> [DealStats] -> ActionOnDate
InspectDS Date
_d [DealStats
ds] | Date
_d <- RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
II Date
sd DatePattern
dp Date
ed ]
    expandInspect Date
sd Date
ed (AP.InspectRpt DatePattern
dp [DealStats]
dss) = [ Date -> [DealStats] -> ActionOnDate
InspectDS Date
_d [DealStats]
dss | Date
_d <- RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
II Date
sd DatePattern
dp Date
ed ] 
  in 
    do 
      (Date
startDate,Date
closingDate,Date
firstPayDate,[ActionOnDate]
pActionDates,[ActionOnDate]
bActionDates,Date
endDate,[ActionOnDate]
custWdates) <- DateDesp
-> DealStatus
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
populateDealDates (TestDeal a -> DateDesp
forall a. TestDeal a -> DateDesp
dates TestDeal a
t) DealStatus
status

      let intEarnDates :: [(String, [Date])]
intEarnDates = [Account] -> Date -> [(String, [Date])] -> [(String, [Date])]
A.buildEarnIntAction (Map String Account -> [Account]
forall k a. Map k a -> [a]
Map.elems (TestDeal a -> Map String Account
forall a. TestDeal a -> Map String Account
accounts TestDeal a
t)) Date
endDate [] 
      let intAccRateResetDates :: [Maybe (String, [Date])]
intAccRateResetDates = (Date -> Account -> Maybe (String, [Date])
A.buildRateResetDates Date
endDate) (Account -> Maybe (String, [Date]))
-> [Account] -> [Maybe (String, [Date])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map String Account -> [Account]
forall k a. Map k a -> [a]
Map.elems (TestDeal a -> Map String Account
forall a. TestDeal a -> Map String Account
accounts TestDeal a
t))
      let iAccIntDates :: [ActionOnDate]
iAccIntDates = [ Date -> String -> ActionOnDate
EarnAccInt Date
_d String
accName | (String
accName,[Date]
accIntDates) <- [(String, [Date])]
intEarnDates , Date
_d <- [Date]
accIntDates ] 
      let iAccRateResetDates :: [ActionOnDate]
iAccRateResetDates = [[ActionOnDate]] -> [ActionOnDate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Date -> String -> ActionOnDate
ResetAccRate Date
_d String
accName | Date
_d <- [Date]
_ds] | rst :: Maybe (String, [Date])
rst@(Just (String
accName, [Date]
_ds)) <- [Maybe (String, [Date])]
intAccRateResetDates, Maybe (String, [Date]) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (String, [Date])
rst ]
    
      --fee accrue dates 
      let _feeAccrueDates :: [(String, [Date])]
_feeAccrueDates = [Fee] -> Date -> [(String, [Date])] -> [(String, [Date])]
F.buildFeeAccrueAction (Map String Fee -> [Fee]
forall k a. Map k a -> [a]
Map.elems Map String Fee
feeMap) Date
endDate [] 
      let feeAccrueDates :: [ActionOnDate]
feeAccrueDates = [ Date -> String -> ActionOnDate
AccrueFee Date
_d String
_feeName | (String
_feeName,[Date]
feeAccureDates) <- [(String, [Date])]
_feeAccrueDates , Date
_d <- [Date]
feeAccureDates ]
    --liquidation facility
      let liqResetDates :: [ActionOnDate]
liqResetDates = case TestDeal a -> Maybe (Map String LiqFacility)
forall a. TestDeal a -> Maybe (Map String LiqFacility)
liqProvider TestDeal a
t of 
                        Maybe (Map String LiqFacility)
Nothing -> []
                        Just Map String LiqFacility
mLiqProvider -> 
                            let 
                              _liqResetDates :: [(String, [Date])]
_liqResetDates = [LiqFacility] -> Date -> [(String, [Date])] -> [(String, [Date])]
CE.buildLiqResetAction (Map String LiqFacility -> [LiqFacility]
forall k a. Map k a -> [a]
Map.elems Map String LiqFacility
mLiqProvider) Date
endDate []
                              _liqRateResetDates :: [(String, [Date])]
_liqRateResetDates = [LiqFacility] -> Date -> [(String, [Date])] -> [(String, [Date])]
CE.buildLiqRateResetAction (Map String LiqFacility -> [LiqFacility]
forall k a. Map k a -> [a]
Map.elems Map String LiqFacility
mLiqProvider) Date
endDate []
                            in 
                              [ Date -> String -> ActionOnDate
ResetLiqProvider Date
_d String
_liqName |(String
_liqName,[Date]
__liqResetDates) <- [(String, [Date])]
_liqResetDates , Date
_d <- [Date]
__liqResetDates ]
                              [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ 
                              [ Date -> String -> ActionOnDate
ResetLiqProviderRate Date
_d String
_liqName |(String
_liqName,[Date]
__liqResetDates) <- [(String, [Date])]
_liqRateResetDates , Date
_d <- [Date]
__liqResetDates ]                            
    --inspect dates 
      let inspectDates :: [ActionOnDate]
inspectDates = case Maybe NonPerfAssumption
mNonPerfAssump of
                          Just AP.NonPerfAssumption{inspectOn :: NonPerfAssumption -> Maybe [InspectType]
AP.inspectOn = Just [InspectType]
inspectList } -> (InspectType -> [ActionOnDate]) -> [InspectType] -> [ActionOnDate]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap  (Date -> Date -> InspectType -> [ActionOnDate]
expandInspect Date
startDate Date
endDate) [InspectType]
inspectList
                          Maybe NonPerfAssumption
_ -> []
    
      let financialRptDates :: [ActionOnDate]
financialRptDates = case Maybe NonPerfAssumption
mNonPerfAssump of 
                            Just AP.NonPerfAssumption{buildFinancialReport :: NonPerfAssumption -> Maybe DatePattern
AP.buildFinancialReport= Just DatePattern
dp } 
                              -> let 
                                   (Date
s:[Date]
_ds) = RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
II Date
startDate DatePattern
dp Date
endDate 
                                 in 
                                   [ Date -> Date -> ActionOnDate
BuildReport Date
_sd Date
_ed  | (Date
_sd,Date
_ed) <- [Date] -> [Date] -> [(Date, Date)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Date
sDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[Date]
_ds) [Date]
_ds ] -- `debug` ("ds"++ show _ds)
                            Maybe NonPerfAssumption
_ -> []

      let irUpdateSwapDates :: [[ActionOnDate]]
irUpdateSwapDates = case TestDeal a -> Maybe (Map String RateSwap)
forall a. TestDeal a -> Maybe (Map String RateSwap)
rateSwap TestDeal a
t of
                          Maybe (Map String RateSwap)
Nothing -> []
                          Just Map String RateSwap
rsm -> Map String [ActionOnDate] -> [[ActionOnDate]]
forall k a. Map k a -> [a]
Map.elems (Map String [ActionOnDate] -> [[ActionOnDate]])
-> Map String [ActionOnDate] -> [[ActionOnDate]]
forall a b. (a -> b) -> a -> b
$ (String -> RateSwap -> [ActionOnDate])
-> Map String RateSwap -> Map String [ActionOnDate]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
                                                   (\String
k RateSwap
x -> let 
                                                             resetDs :: [Date]
resetDs = RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
EE (RateSwap -> Date
HE.rsStartDate RateSwap
x) (RateSwap -> DatePattern
HE.rsUpdateDates RateSwap
x) Date
endDate
                                                            in 
                                                             (Date -> String -> ActionOnDate) -> String -> Date -> ActionOnDate
forall a b c. (a -> b -> c) -> b -> a -> c
flip Date -> String -> ActionOnDate
CalcIRSwap String
k (Date -> ActionOnDate) -> [Date] -> [ActionOnDate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date]
resetDs)
                                                   Map String RateSwap
rsm
      let irSettleSwapDates :: [[ActionOnDate]]
irSettleSwapDates = case TestDeal a -> Maybe (Map String RateSwap)
forall a. TestDeal a -> Maybe (Map String RateSwap)
rateSwap TestDeal a
t of
                          Maybe (Map String RateSwap)
Nothing -> []
                          Just Map String RateSwap
rsm -> Map String [ActionOnDate] -> [[ActionOnDate]]
forall k a. Map k a -> [a]
Map.elems (Map String [ActionOnDate] -> [[ActionOnDate]])
-> Map String [ActionOnDate] -> [[ActionOnDate]]
forall a b. (a -> b) -> a -> b
$ (String -> RateSwap -> [ActionOnDate])
-> Map String RateSwap -> Map String [ActionOnDate]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
                                                    (\String
k x :: RateSwap
x@HE.RateSwap{ rsSettleDates :: RateSwap -> Maybe (DatePattern, String)
HE.rsSettleDates = Maybe (DatePattern, String)
sDates} ->
                                                      case Maybe (DatePattern, String)
sDates of 
                                                        Maybe (DatePattern, String)
Nothing -> []
                                                        Just (DatePattern
sdp,String
_) ->
                                                          let 
                                                            resetDs :: [Date]
resetDs = RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
EE (RateSwap -> Date
HE.rsStartDate RateSwap
x) DatePattern
sdp Date
endDate
                                                          in 
                                                            (Date -> String -> ActionOnDate) -> String -> Date -> ActionOnDate
forall a b c. (a -> b -> c) -> b -> a -> c
flip Date -> String -> ActionOnDate
SettleIRSwap String
k (Date -> ActionOnDate) -> [Date] -> [ActionOnDate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date]
resetDs)
                                                    Map String RateSwap
rsm
      let rateCapSettleDates :: [[ActionOnDate]]
rateCapSettleDates = case TestDeal a -> Maybe (Map String RateCap)
forall a. TestDeal a -> Maybe (Map String RateCap)
rateCap TestDeal a
t of 
                             Maybe (Map String RateCap)
Nothing -> []
                             Just Map String RateCap
rcM -> Map String [ActionOnDate] -> [[ActionOnDate]]
forall k a. Map k a -> [a]
Map.elems (Map String [ActionOnDate] -> [[ActionOnDate]])
-> Map String [ActionOnDate] -> [[ActionOnDate]]
forall a b. (a -> b) -> a -> b
$ (String -> RateCap -> [ActionOnDate])
-> Map String RateCap -> Map String [ActionOnDate]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
                                                       (\String
k RateCap
x -> let 
                                                                  resetDs :: [Date]
resetDs = RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
EE (RateCap -> Date
HE.rcStartDate RateCap
x) (RateCap -> DatePattern
HE.rcSettleDates RateCap
x) Date
endDate
                                                                in 
                                                                  (Date -> String -> ActionOnDate) -> String -> Date -> ActionOnDate
forall a b c. (a -> b -> c) -> b -> a -> c
flip Date -> String -> ActionOnDate
AccrueCapRate String
k (Date -> ActionOnDate) -> [Date] -> [ActionOnDate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date]
resetDs)
                                                       Map String RateCap
rcM
    -- bond rate resets 
      let bndRateResets :: [ActionOnDate]
bndRateResets = let 
                        bndWithDate :: [(String, [Date])]
bndWithDate = Map String [Date] -> [(String, [Date])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String [Date] -> [(String, [Date])])
-> Map String [Date] -> [(String, [Date])]
forall a b. (a -> b) -> a -> b
$ (Bond -> [Date]) -> Map String Bond -> Map String [Date]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                                  (\Bond
b -> Bond -> Date -> Date -> [Date]
L.buildRateResetDates Bond
b Date
closingDate Date
endDate) 
                                                  Map String Bond
bndMap
                      in 
                        [ Date -> String -> ActionOnDate
ResetBondRate Date
bdate String
bn | (String
bn, [Date]
bdates) <- [(String, [Date])]
bndWithDate
                                                    , Date
bdate <- [Date]
bdates ] 

    -- bond step ups events
      let bndStepUpDates :: [ActionOnDate]
bndStepUpDates = let 
                        bndWithDate :: [(String, [Date])]
bndWithDate = Map String [Date] -> [(String, [Date])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String [Date] -> [(String, [Date])])
-> Map String [Date] -> [(String, [Date])]
forall a b. (a -> b) -> a -> b
$ (Bond -> [Date]) -> Map String Bond -> Map String [Date]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                                  (\Bond
b -> Bond -> Date -> Date -> [Date]
L.buildStepUpDates Bond
b Date
closingDate Date
endDate) 
                                                  Map String Bond
bndMap
                      in
                        [ Date -> String -> ActionOnDate
StepUpBondRate Date
bdate String
bn  | (String
bn, [Date]
bdates) <- [(String, [Date])]
bndWithDate , Date
bdate <- [Date]
bdates ] 

    -- mannual triggers 
      let mannualTrigger :: [ActionOnDate]
mannualTrigger = case Maybe NonPerfAssumption
mNonPerfAssump of 
                            Just AP.NonPerfAssumption{fireTrigger :: NonPerfAssumption -> Maybe [(Date, DealCycle, String)]
AP.fireTrigger = Just [(Date, DealCycle, String)]
evts} -> [ Date -> DealCycle -> String -> ActionOnDate
FireTrigger Date
d DealCycle
cycle String
n | (Date
d,DealCycle
cycle,String
n) <- [(Date, DealCycle, String)]
evts]
                            Maybe NonPerfAssumption
_ -> []

    -- make whole assumption
      let makeWholeDate :: [ActionOnDate]
makeWholeDate = case Maybe NonPerfAssumption
mNonPerfAssump of
                            Just AP.NonPerfAssumption{makeWholeWhen :: NonPerfAssumption -> Maybe (Date, IRate, Table Float IRate)
AP.makeWholeWhen = Just (Date
_d,IRate
_s,Table Float IRate
_t)} -> [Date -> IRate -> Table Float IRate -> ActionOnDate
MakeWhole Date
_d IRate
_s Table Float IRate
_t]
                            Maybe NonPerfAssumption
_ -> [] 

    -- issue bonds in the future 
      let bondIssuePlan :: [ActionOnDate]
bondIssuePlan = case Maybe NonPerfAssumption
mNonPerfAssump of 
                            Just AP.NonPerfAssumption{issueBondSchedule :: NonPerfAssumption -> Maybe [TsPoint IssueBondEvent]
AP.issueBondSchedule = Just [TsPoint IssueBondEvent]
bndPlan} 
                              -> [ Date
-> Maybe Pre
-> String
-> String
-> Bond
-> Maybe DealStats
-> Maybe DealStats
-> ActionOnDate
IssueBond Date
_d Maybe Pre
mPre String
bGroupName String
accName Bond
b Maybe DealStats
mBal Maybe DealStats
mRate | TsPoint Date
_d (AP.IssueBondEvent Maybe Pre
mPre String
bGroupName String
accName Bond
b Maybe DealStats
mBal Maybe DealStats
mRate) <- [TsPoint IssueBondEvent]
bndPlan]
                                  [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ [Date -> Maybe Pre -> String -> String -> Balance -> ActionOnDate
FundBond Date
_d Maybe Pre
mPre String
bName String
accName Balance
amount | TsPoint Date
_d (AP.FundingBondEvent Maybe Pre
mPre String
bName String
accName Balance
amount) <- [TsPoint IssueBondEvent]
bndPlan]
                            Maybe NonPerfAssumption
_ -> []

    -- refinance bonds in the future 
      let bondRefiPlan :: [ActionOnDate]
bondRefiPlan = case Maybe NonPerfAssumption
mNonPerfAssump of 
                        Just AP.NonPerfAssumption{refinance :: NonPerfAssumption -> Maybe [TsPoint RefiEvent]
AP.refinance = Just [TsPoint RefiEvent]
bndPlan} 
                          -> [ Date -> String -> String -> InterestInfo -> ActionOnDate
RefiBondRate Date
_d String
accName String
bName InterestInfo
iInfo | TsPoint Date
_d (AP.RefiRate String
accName String
bName InterestInfo
iInfo) <- [TsPoint RefiEvent]
bndPlan]
                            [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ [ Date -> String -> Bond -> ActionOnDate
RefiBond Date
_d String
accName Bond
bnd | TsPoint Date
_d (AP.RefiBond String
accName Bond
bnd) <- [TsPoint RefiEvent]
bndPlan] 
                             
                        Maybe NonPerfAssumption
_ -> []

      let extractTestDates :: CallOpt -> [ActionOnDate]
extractTestDates (AP.CallOnDates DatePattern
dp [Pre]
_) = [Date -> ActionOnDate
TestCall Date
x | Date
x <- RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
EE Date
startDate DatePattern
dp Date
endDate ]
      let extractTestDates :: p -> [a]
extractTestDates p
_ = []
    -- extractTestDates (AP.CallOptions opts) = concat [ extractTestDates opt | opt <- opts ]
    -- call test dates 
      let callDates :: [ActionOnDate]
callDates = case Maybe NonPerfAssumption
mNonPerfAssump of
                    Just AP.NonPerfAssumption{callWhen :: NonPerfAssumption -> Maybe [CallOpt]
AP.callWhen = Just [CallOpt]
callOpts}
                      -> [[ActionOnDate]] -> [ActionOnDate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ CallOpt -> [ActionOnDate]
forall {p} {a}. p -> [a]
extractTestDates CallOpt
callOpt | CallOpt
callOpt <- [CallOpt]
callOpts ]
                    Maybe NonPerfAssumption
_ -> []
      let stopTestDates :: [ActionOnDate]
stopTestDates = case Maybe NonPerfAssumption
mNonPerfAssump of
		    	    Just AP.NonPerfAssumption{stopRunBy :: NonPerfAssumption -> Maybe StopBy
AP.stopRunBy = Just (AP.StopByPre DatePattern
dp [Pre]
pres)} 
			    	-> [Date -> [Pre] -> ActionOnDate
StopRunTest Date
d [Pre]
pres | Date
d <- RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
EI Date
startDate DatePattern
dp Date
endDate]
		    	    Maybe NonPerfAssumption
_ -> []
      let allActionDates :: [ActionOnDate]
allActionDates = let 
                         __actionDates :: [ActionOnDate]
__actionDates = let 
                                          a :: [ActionOnDate]
a = [[ActionOnDate]] -> [ActionOnDate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ActionOnDate]
bActionDates,[ActionOnDate]
pActionDates,[ActionOnDate]
custWdates,[ActionOnDate]
iAccIntDates,[ActionOnDate]
makeWholeDate
                                                     ,[ActionOnDate]
feeAccrueDates,[ActionOnDate]
liqResetDates,[ActionOnDate]
mannualTrigger,[[ActionOnDate]] -> [ActionOnDate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ActionOnDate]]
rateCapSettleDates
                                                     ,[[ActionOnDate]] -> [ActionOnDate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ActionOnDate]]
irUpdateSwapDates, [[ActionOnDate]] -> [ActionOnDate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ActionOnDate]]
irSettleSwapDates ,[ActionOnDate]
inspectDates, [ActionOnDate]
bndRateResets,[ActionOnDate]
financialRptDates, [ActionOnDate]
stopTestDates
                                                     ,[ActionOnDate]
bondIssuePlan,[ActionOnDate]
bondRefiPlan,[ActionOnDate]
callDates, [ActionOnDate]
iAccRateResetDates 
                                                     ,[ActionOnDate]
bndStepUpDates] 
                                        in
                                          case (TestDeal a -> DateDesp
forall a. TestDeal a -> DateDesp
dates TestDeal a
t,DealStatus
status) of 
                                            (PreClosingDates {}, PreClosing DealStatus
_) -> (ActionOnDate -> ActionOnDate -> Ordering)
-> [ActionOnDate] -> [ActionOnDate]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ActionOnDate -> ActionOnDate -> Ordering
sortActionOnDate ([ActionOnDate] -> [ActionOnDate])
-> [ActionOnDate] -> [ActionOnDate]
forall a b. (a -> b) -> a -> b
$ Date -> ActionOnDate
DealClosed Date
closingDateActionOnDate -> [ActionOnDate] -> [ActionOnDate]
forall a. a -> [a] -> [a]
:[ActionOnDate]
a 
                                            (DateDesp, DealStatus)
_ -> (ActionOnDate -> ActionOnDate -> Ordering)
-> [ActionOnDate] -> [ActionOnDate]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ActionOnDate -> ActionOnDate -> Ordering
sortActionOnDate [ActionOnDate]
a
                         _actionDates :: [ActionOnDate]
_actionDates = [ActionOnDate]
__actionDates[ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++[Date -> ActionOnDate
HitStatedMaturity Date
endDate]
                       in 
                         case Maybe NonPerfAssumption
mNonPerfAssump of
                           Just AP.NonPerfAssumption{stopRunBy :: NonPerfAssumption -> Maybe StopBy
AP.stopRunBy = Just (AP.StopByDate Date
d)} -> CutoffType
-> DateDirection -> Date -> [ActionOnDate] -> [ActionOnDate]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Exc DateDirection
Past Date
d [ActionOnDate]
__actionDates [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ [Date -> ActionOnDate
StopRunFlag Date
d]
                           Maybe NonPerfAssumption
_ -> [ActionOnDate]
_actionDates  
     
      let newFeeMap :: Map String Fee
newFeeMap = case Maybe NonPerfAssumption
mNonPerfAssump of
                        Maybe NonPerfAssumption
Nothing -> Map String Fee
feeMap
                        Just AP.NonPerfAssumption{projectedExpense :: NonPerfAssumption -> Maybe [(String, Ts)]
AP.projectedExpense = Maybe [(String, Ts)]
Nothing } -> Map String Fee
feeMap
                        Just AP.NonPerfAssumption{projectedExpense :: NonPerfAssumption -> Maybe [(String, Ts)]
AP.projectedExpense = Just [(String, Ts)]
pairs } 
                          ->   ((String, Ts) -> Map String Fee -> Map String Fee)
-> Map String Fee -> [(String, Ts)] -> Map String Fee
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr  (\(String
feeName,Ts
feeFlow) Map String Fee
accM -> (Fee -> Fee) -> String -> Map String Fee -> Map String Fee
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\Fee
v -> Fee
v {F.feeType = F.FeeFlow feeFlow}) String
feeName Map String Fee
accM)  Map String Fee
feeMap [(String, Ts)]
pairs
      Map PoolId PoolCashflow
pCfM <- Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either String (Map PoolId PoolCashflow)
forall a.
Asset a =>
Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either String (Map PoolId PoolCashflow)
runPoolType Bool
True PoolType a
thePool Maybe ApplyAssumptionType
mAssumps Maybe NonPerfAssumption
mNonPerfAssump
      Map PoolId PoolCashflow
pScheduleCfM <- Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either String (Map PoolId PoolCashflow)
forall a.
Asset a =>
Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either String (Map PoolId PoolCashflow)
runPoolType Bool
True PoolType a
thePool Maybe ApplyAssumptionType
forall a. Maybe a
Nothing Maybe NonPerfAssumption
mNonPerfAssump
      let aggDates :: [Date]
aggDates = [ActionOnDate] -> [Date]
forall ts. TimeSeries ts => [ts] -> [Date]
getDates [ActionOnDate]
pActionDates
      let pCollectionCfAfterCutoff :: Map PoolId PoolCashflow
pCollectionCfAfterCutoff = (PoolCashflow -> PoolCashflow)
-> Map PoolId PoolCashflow -> Map PoolId PoolCashflow
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                       (\(CashFlowFrame
pCf, Maybe [CashFlowFrame]
mAssetFlow) -> 
					let 
                                          pCf' :: CashFlowFrame
pCf' = Date -> [Date] -> CashFlowFrame -> CashFlowFrame
CF.cutoffCashflow Date
startDate [Date]
aggDates CashFlowFrame
pCf
					in
					  (CashFlowFrame
pCf' ,(\[CashFlowFrame]
xs -> [ Date -> [Date] -> CashFlowFrame -> CashFlowFrame
CF.cutoffCashflow Date
startDate [Date]
aggDates CashFlowFrame
x | CashFlowFrame
x <- [CashFlowFrame]
xs ] ) ([CashFlowFrame] -> [CashFlowFrame])
-> Maybe [CashFlowFrame] -> Maybe [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CashFlowFrame]
mAssetFlow))
                                       Map PoolId PoolCashflow
pCfM

      let pUnstressedAfterCutoff :: Map PoolId PoolCashflow
pUnstressedAfterCutoff = (PoolCashflow -> PoolCashflow)
-> Map PoolId PoolCashflow -> Map PoolId PoolCashflow
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                       (\(CashFlowFrame
pCf, Maybe [CashFlowFrame]
mAssetFlow) -> 
					let 
					  pCf' :: CashFlowFrame
pCf' = Date -> [Date] -> CashFlowFrame -> CashFlowFrame
CF.cutoffCashflow Date
startDate [Date]
aggDates CashFlowFrame
pCf
					in 
				          (CashFlowFrame
pCf'
					   ,(\[CashFlowFrame]
xs -> [ Date -> [Date] -> CashFlowFrame -> CashFlowFrame
CF.cutoffCashflow Date
startDate [Date]
aggDates CashFlowFrame
x | CashFlowFrame
x <- [CashFlowFrame]
xs ]) ([CashFlowFrame] -> [CashFlowFrame])
-> Maybe [CashFlowFrame] -> Maybe [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CashFlowFrame]
mAssetFlow)
	                               )
                                       Map PoolId PoolCashflow
pScheduleCfM

      let poolWithSchedule :: PoolType a
poolWithSchedule = Map PoolId PoolCashflow -> PoolType a -> PoolType a
forall a.
Asset a =>
Map PoolId PoolCashflow -> PoolType a -> PoolType a
patchScheduleFlow Map PoolId PoolCashflow
pUnstressedAfterCutoff PoolType a
thePool -- `debug` ("D")
      let poolWithIssuanceBalance :: PoolType a
poolWithIssuanceBalance = DealStatus -> Map PoolId Balance -> PoolType a -> PoolType a
forall a.
Asset a =>
DealStatus -> Map PoolId Balance -> PoolType a -> PoolType a
patchIssuanceBalance 
                                      DealStatus
status 
				      ((\(CashFlowFrame
_pflow,Maybe [CashFlowFrame]
_) -> CashFlowFrame -> Balance
CF.getBegBalCashFlowFrame CashFlowFrame
_pflow) (PoolCashflow -> Balance)
-> Map PoolId PoolCashflow -> Map PoolId Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PoolId PoolCashflow
pCollectionCfAfterCutoff)
                                      PoolType a
poolWithSchedule
      let poolWithRunPoolBalance :: PoolType a
poolWithRunPoolBalance = Map PoolId Balance -> PoolType a -> PoolType a
forall a. Asset a => Map PoolId Balance -> PoolType a -> PoolType a
patchRuntimeBal 
                                     ((PoolCashflow -> Balance)
-> Map PoolId PoolCashflow -> Map PoolId Balance
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(CF.CashFlowFrame (Balance
b,Date
_,Maybe Balance
_) [TsRow]
_,Maybe [CashFlowFrame]
_) -> Balance
b) Map PoolId PoolCashflow
pCollectionCfAfterCutoff) 
				     PoolType a
poolWithIssuanceBalance

      let newStat :: (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
newStat = if (TestDeal a -> Bool
forall a. TestDeal a -> Bool
isPreClosing TestDeal a
t) then 
                      (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
_stats (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
-> ((BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
    -> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap))
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
forall a b. a -> (a -> b) -> b
& (ASetter
  (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
  (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
  IDealStatMap
  IDealStatMap
-> (IDealStatMap -> IDealStatMap)
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
  (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
  IDealStatMap
  IDealStatMap
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
  (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
  IDealStatMap
  IDealStatMap
_4) (IDealStatMap -> IDealStatMap -> IDealStatMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` ([(DealStatFields, Int)] -> IDealStatMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DealStatFields
BondPaidPeriod,Int
0),(DealStatFields
PoolCollectedPeriod,Int
0)]))
                    else 
                      (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
_stats
      (TestDeal a, [ActionOnDate], Map PoolId PoolCashflow,
 Map PoolId PoolCashflow)
-> Either
     String
     (TestDeal a, [ActionOnDate], Map PoolId PoolCashflow,
      Map PoolId PoolCashflow)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t {fees = newFeeMap , pool = poolWithRunPoolBalance , stats = newStat}
             , [ActionOnDate]
allActionDates
             , Map PoolId PoolCashflow
pCollectionCfAfterCutoff
             , Map PoolId PoolCashflow
pUnstressedAfterCutoff)

$(deriveJSON defaultOptions ''ExpectReturn)