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

module Deal (run,runPool,getInits,runDeal,ExpectReturn(..)
            ,performAction
            ,populateDealDates,accrueRC
            ,calcTargetAmount,updateLiqProvider
            ,projAssetUnion,priceAssetUnion
            ,removePoolCf,runPoolType,PoolType
            ,ActionOnDate(..),DateDesp(..)
            ,changeDealStatus
            ) where

import Control.Parallel.Strategies
import qualified Accounts as A
import qualified Ledger as LD
import qualified Asset as Ast
import qualified Pool as P
import qualified Expense as F
import qualified Liability as L
import qualified CreditEnhancement as CE
import qualified Analytics
import qualified Waterfall as W
import qualified Cashflow as CF
import qualified Assumptions as AP
import qualified Reports as Rpt
import qualified AssetClass.AssetBase as ACM
import AssetClass.Mortgage
import AssetClass.Lease
import AssetClass.Loan
import AssetClass.Installment
import AssetClass.MixedAsset

import qualified Call as C
import qualified InterestRate as IR
import Deal.DealBase
import Deal.DealQuery
import Deal.DealAction
import qualified Deal.DealValidation as V
import Stmt
import Lib
import Util
import DateUtil
import Types
import Revolving
import Triggers

import qualified Data.Map as Map hiding (mapEither)
import qualified Data.Time as T
import qualified Data.Set as S
import qualified Control.Lens as LS
import Data.List
import qualified Data.DList as DL
import Data.Fixed
import Data.Time.Clock
import Data.Maybe
import Data.Either
import Data.Aeson hiding (json)
import qualified Data.Aeson.Encode.Pretty as Pretty
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import GHC.Generics
import Control.Monad
import Control.Monad.Writer
import Control.Monad.Loops (allM,anyM)
import Control.Applicative (liftA2)

import Debug.Trace
import Cashflow (buildBegTsRow)
import Assumptions (NonPerfAssumption(NonPerfAssumption),lookupRate0)
import Asset ()
import Pool (issuanceStat)
import qualified Types as P
import Control.Lens hiding (element)
import Control.Lens.TH
import Data.Either.Utils
import InterestRate (calcInt)
import Liability (getDayCountFromInfo,getTxnRate)
import Hedge (RateCap(..),RateSwapBase(..),RateSwap(rsRefBalance))
import qualified Hedge as HE

debug :: c -> [Char] -> c
debug = ([Char] -> c -> c) -> c -> [Char] -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> c -> c
forall a. [Char] -> a -> a
trace

-- ^ update bond interest rate from rate assumption
setBondNewRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond
setBondNewRate :: forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond [Char]
_ BondType
_ L.OriginalInfo{ originDate :: OriginalInfo -> Date
L.originDate = Date
od} InterestInfo
ii Maybe StepUp
_ Balance
bal IRate
currentRate Balance
_ Balance
dueInt Balance
_ Maybe Date
Nothing Maybe Date
_ Maybe Date
_ Maybe Statement
_)
  = TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras Bond
b {L.bndDueIntDate = Just od}

-- ^ Floater rate
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond [Char]
_ BondType
_ OriginalInfo
_ ii :: InterestInfo
ii@(L.Floater IRate
br Index
idx IRate
_spd RateReset
rset DayCount
dc Maybe IRate
mf Maybe IRate
mc) Maybe StepUp
_ Balance
bal IRate
currentRate Balance
_ Balance
dueInt Balance
_ (Just Date
dueIntDate) Maybe Date
_ Maybe Date
_ Maybe Statement
_)
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ (Date -> Bond -> Bond
L.accrueInt Date
d Bond
b){ L.bndRate = applyFloatRate ii d ras }

-- ^ Fix rate, do nothing
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond [Char]
_ BondType
_ OriginalInfo
_ L.Fix {} Maybe StepUp
_ Balance
bal IRate
currentRate Balance
_ Balance
dueInt Balance
_ (Just Date
dueIntDate) Maybe Date
_ Maybe Date
_ Maybe Statement
_)
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right Bond
b

-- ^ Ref rate
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond [Char]
_ BondType
_ OriginalInfo
_ (L.RefRate IRate
sr DealStats
ds Float
factor RateReset
_) Maybe StepUp
_ Balance
bal IRate
currentRate Balance
_ Balance
dueInt Balance
_ (Just Date
dueIntDate) Maybe Date
_ Maybe Date
_ Maybe Statement
_) 
  = do
      let b' :: Bond
b' = Date -> Bond -> Bond
L.accrueInt Date
d Bond
b
      Rate
rate <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
      Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Bond
b' {L.bndRate = fromRational (rate * toRational factor) }

-- ^ cap & floor & IoI
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond [Char]
_ BondType
_ OriginalInfo
_ InterestInfo
ii Maybe StepUp
_ Balance
bal IRate
currentRate Balance
_ Balance
dueInt Balance
_ (Just Date
dueIntDate) Maybe Date
_ Maybe Date
_ Maybe Statement
_) 
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ (Date -> Bond -> Bond
L.accrueInt Date
d Bond
b) { L.bndRate = applyFloatRate ii d ras}

-- ^ bond group
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras bg :: Bond
bg@(L.BondGroup Map [Char] Bond
bMap Maybe BondType
pt)
  = do 
      Map [Char] Bond
m <- (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras) Map [Char] Bond
bMap
      Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond -> Maybe BondType -> Bond
L.BondGroup Map [Char] Bond
m Maybe BondType
pt

-- ^ apply all rates for multi-int bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.MultiIntBond [Char]
bn BondType
_ OriginalInfo
_ [InterestInfo]
iis Maybe [StepUp]
_ Balance
bal [IRate]
currentRates Balance
_ [Balance]
dueInts [Balance]
dueIoIs Maybe Date
_ Maybe [Date]
_ Maybe Date
_ Maybe Statement
_)
  = let 
      newRates :: [IRate]
newRates = InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate (InterestInfo -> Date -> [RateAssumption] -> IRate)
-> [InterestInfo] -> [Date -> [RateAssumption] -> IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InterestInfo]
iis [Date -> [RateAssumption] -> IRate]
-> [Date] -> [[RateAssumption] -> IRate]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Date -> [Date]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Date
d [[RateAssumption] -> IRate] -> [[RateAssumption]] -> [IRate]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [RateAssumption] -> [[RateAssumption]]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RateAssumption]
ras
      b' :: Bond
b' = Date -> Bond -> Bond
L.accrueInt Date
d Bond
b -- `debug` ("accrue due to new rate "++ bn)
    in
      Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Bond
b' { L.bndRates = newRates } 



setBondStepUpRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> L.Bond -> Either String L.Bond
setBondStepUpRate :: forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
setBondStepUpRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond [Char]
_ BondType
_ OriginalInfo
_ InterestInfo
ii (Just StepUp
sp) Balance
_ IRate
_ Balance
_ Balance
_ Balance
_ Maybe Date
_ Maybe Date
_ Maybe Date
_ Maybe Statement
_)
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ 
      let 
        newII :: InterestInfo
newII = StepUp -> InterestInfo -> InterestInfo
L.stepUpInterestInfo StepUp
sp InterestInfo
ii
        newRate :: IRate
newRate = InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate InterestInfo
ii Date
d [RateAssumption]
ras
      in 
        (Date -> Bond -> Bond
L.accrueInt Date
d Bond
b) { L.bndInterestInfo = newII, L.bndRate = newRate }

setBondStepUpRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.MultiIntBond [Char]
bn BondType
_ OriginalInfo
_ [InterestInfo]
iis (Just [StepUp]
sps) Balance
_ [IRate]
_ Balance
_ [Balance]
_ [Balance]
_ Maybe Date
_ Maybe [Date]
_ Maybe Date
_ Maybe Statement
_)
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ 
      let 
        newIIs :: [InterestInfo]
newIIs = (StepUp -> InterestInfo -> InterestInfo)
-> [StepUp] -> [InterestInfo] -> [InterestInfo]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith StepUp -> InterestInfo -> InterestInfo
L.stepUpInterestInfo [StepUp]
sps [InterestInfo]
iis
        newRates :: [IRate]
newRates = (\InterestInfo
x -> InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate InterestInfo
x Date
d [RateAssumption]
ras) (InterestInfo -> IRate) -> [InterestInfo] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InterestInfo]
newIIs
      in 
        (Date -> Bond -> Bond
L.accrueInt Date
d Bond
b) { L.bndInterestInfos = newIIs, L.bndRates = newRates }  -- `debug` (show d ++ ">> accure due to step up rate "++ bn)

setBondStepUpRate TestDeal a
t Date
d [RateAssumption]
ras bg :: Bond
bg@(L.BondGroup Map [Char] Bond
bMap Maybe BondType
pt)
  = do 
      Map [Char] Bond
m <- (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
setBondStepUpRate TestDeal a
t Date
d [RateAssumption]
ras) Map [Char] Bond
bMap
      Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond -> Maybe BondType -> Bond
L.BondGroup Map [Char] Bond
m Maybe BondType
pt



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 [Char] 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 [Char] IRate
applyFloatRate2 RateType
rt Date
d [RateAssumption]
ras 
        SRT -> Either [Char] SRT
forall a. a -> Either [Char] 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 [Char] 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 RateReset
dp -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] 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 [Char] SRT
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return SRT
srt { HE.srtRefBalance = fromRational newBal, HE.srtDuePremium = newPremium, HE.srtDuePremiumDate = Just d}


updateLiqProviderRate :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> CE.LiqFacility -> CE.LiqFacility
updateLiqProviderRate :: forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> LiqFacility -> LiqFacility
updateLiqProviderRate TestDeal a
t Date
d [RateAssumption]
ras liq :: LiqFacility
liq@CE.LiqFacility{liqRateType :: LiqFacility -> Maybe RateType
CE.liqRateType = Maybe RateType
mRt, liqPremiumRateType :: LiqFacility -> Maybe RateType
CE.liqPremiumRateType = Maybe RateType
mPrt
                                                , liqRate :: LiqFacility -> Maybe IRate
CE.liqRate = Maybe IRate
mr, liqPremiumRate :: LiqFacility -> Maybe IRate
CE.liqPremiumRate = Maybe IRate
mPr }
  = let 
      newMr :: Maybe IRate
newMr =  Date -> [RateAssumption] -> RateType -> IRate
evalFloaterRate Date
d [RateAssumption]
ras (RateType -> IRate) -> Maybe RateType -> Maybe IRate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RateType
mRt
      newMpr :: Maybe IRate
newMpr = Date -> [RateAssumption] -> RateType -> IRate
evalFloaterRate Date
d [RateAssumption]
ras (RateType -> IRate) -> Maybe RateType -> Maybe IRate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RateType
mPrt
      -- TODO probably need to accure int when interest rate changes ? 
    in 
      LiqFacility
liq {CE.liqRate = newMr, CE.liqPremiumRate = newMpr }


evalFloaterRate :: Date -> [RateAssumption] -> IR.RateType -> IRate 
evalFloaterRate :: Date -> [RateAssumption] -> RateType -> IRate
evalFloaterRate Date
_ [RateAssumption]
_ (IR.Fix DayCount
_ IRate
r) = IRate
r 
evalFloaterRate Date
d [RateAssumption]
ras (IR.Floater DayCount
_ Index
idx IRate
spd IRate
_r RateReset
_ Maybe IRate
mFloor Maybe IRate
mCap Maybe (RoundingBy IRate)
mRounding)
  = let 
      ra :: Maybe RateAssumption
ra = [RateAssumption] -> Index -> Maybe RateAssumption
AP.getRateAssumption [RateAssumption]
ras Index
idx 
      flooring :: Maybe a -> a -> a
flooring (Just a
f) a
v = a -> a -> a
forall a. Ord a => a -> a -> a
max a
f a
v 
      flooring Maybe a
Nothing a
v = a
v 
      capping :: Maybe a -> a -> a
capping (Just a
f) a
v = a -> a -> a
forall a. Ord a => a -> a -> a
min a
f a
v 
      capping Maybe a
Nothing  a
v = a
v 
    in 
      case Maybe RateAssumption
ra of 
        Maybe RateAssumption
Nothing -> [Char] -> IRate
forall a. HasCallStack => [Char] -> a
error [Char]
"Failed to find index rate in assumption"
        Just (RateFlat Index
_ IRate
v) -> Maybe IRate -> IRate -> IRate
forall {a}. Ord a => Maybe a -> a -> a
capping Maybe IRate
mCap (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ Maybe IRate -> IRate -> IRate
forall {a}. Ord a => Maybe a -> a -> a
flooring Maybe IRate
mFloor (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ IRate
v IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ IRate
spd 
        Just (RateCurve Index
_ Ts
curve) -> Maybe IRate -> IRate -> IRate
forall {a}. Ord a => Maybe a -> a -> a
capping Maybe IRate
mCap (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ Maybe IRate -> IRate -> IRate
forall {a}. Ord a => Maybe a -> a -> a
flooring Maybe IRate
mFloor (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational (Rate -> IRate) -> Rate -> IRate
forall a b. (a -> b) -> a -> b
$ Ts -> CutoffType -> Date -> Rate
getValByDate Ts
curve CutoffType
Inc Date
d Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+ IRate -> Rate
forall a. Real a => a -> Rate
toRational IRate
spd

applyFloatRate :: L.InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate :: InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate (L.Floater IRate
_ Index
idx IRate
spd RateReset
p DayCount
dc Maybe IRate
mf Maybe IRate
mc) Date
d [RateAssumption]
ras
  = case (Maybe IRate
mf,Maybe IRate
mc) of
      (Maybe IRate
Nothing,Maybe IRate
Nothing) -> IRate
_rate
      (Just IRate
f,Maybe IRate
Nothing) -> IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
max IRate
f IRate
_rate
      (Just IRate
f,Just IRate
c) -> IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
min IRate
c (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
max IRate
f IRate
_rate
      (Maybe IRate
Nothing,Just IRate
c) -> IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
min IRate
c IRate
_rate
    where
      idx_rate :: IRate
idx_rate = case Maybe RateAssumption
ra of 
        Just (RateCurve Index
_idx Ts
_ts) -> Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational (Rate -> IRate) -> Rate -> IRate
forall a b. (a -> b) -> a -> b
$ Ts -> CutoffType -> Date -> Rate
getValByDate Ts
_ts CutoffType
Exc Date
d
        Just (RateFlat Index
_idx IRate
_r) ->   IRate
_r
        Maybe RateAssumption
Nothing -> IRate
0.0
      ra :: Maybe RateAssumption
ra = [RateAssumption] -> Index -> Maybe RateAssumption
AP.getRateAssumption [RateAssumption]
ras Index
idx
      _rate :: IRate
_rate = IRate
idx_rate IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ IRate
spd -- `debug` ("idx"++show idx_rate++"spd"++show spd)

applyFloatRate (L.CapRate InterestInfo
ii IRate
_rate) Date
d [RateAssumption]
ras = IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
min IRate
_rate (InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate InterestInfo
ii Date
d [RateAssumption]
ras)
applyFloatRate (L.FloorRate InterestInfo
ii IRate
_rate) Date
d [RateAssumption]
ras = IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
max IRate
_rate (InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate InterestInfo
ii Date
d [RateAssumption]
ras)
applyFloatRate (L.Fix IRate
r DayCount
_ ) Date
d [RateAssumption]
ras = IRate
r
applyFloatRate (L.WithIoI InterestInfo
ii InterestOverInterestType
_) Date
d [RateAssumption]
ras = InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate InterestInfo
ii Date
d [RateAssumption]
ras

applyFloatRate2 :: IR.RateType -> Date -> [RateAssumption] -> Either String IRate
applyFloatRate2 :: RateType -> Date -> [RateAssumption] -> Either [Char] IRate
applyFloatRate2 (IR.Fix DayCount
_ IRate
r) Date
_ [RateAssumption]
_ = IRate -> Either [Char] IRate
forall a b. b -> Either a b
Right IRate
r
applyFloatRate2 (IR.Floater DayCount
_ Index
idx IRate
spd IRate
_r RateReset
_ Maybe IRate
mFloor Maybe IRate
mCap Maybe (RoundingBy IRate)
mRounding) Date
d [RateAssumption]
ras
  = let 
      flooring :: Maybe a -> a -> a
flooring (Just a
f) a
v = a -> a -> a
forall a. Ord a => a -> a -> a
max a
f a
v 
      flooring Maybe a
Nothing a
v = a
v 
      capping :: Maybe a -> a -> a
capping (Just a
f) a
v = a -> a -> a
forall a. Ord a => a -> a -> a
min a
f a
v 
      capping Maybe a
Nothing  a
v = a
v 
    in 
      do 
        IRate
rateAtDate <- [RateAssumption] -> Index -> Date -> Either [Char] IRate
AP.lookupRate0 [RateAssumption]
ras Index
idx Date
d 
        IRate -> Either [Char] IRate
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate -> Either [Char] IRate) -> IRate -> Either [Char] IRate
forall a b. (a -> b) -> a -> b
$ Maybe IRate -> IRate -> IRate
forall {a}. Ord a => Maybe a -> a -> a
flooring Maybe IRate
mFloor (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ Maybe IRate -> IRate -> IRate
forall {a}. Ord a => Maybe a -> a -> a
capping Maybe IRate
mCap (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ IRate
rateAtDate IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ IRate
spd

updateRateSwapRate :: Ast.Asset a => TestDeal a -> Maybe [RateAssumption] -> Date -> HE.RateSwap -> Either String HE.RateSwap
updateRateSwapRate :: forall a.
Asset a =>
TestDeal a
-> Maybe [RateAssumption]
-> Date
-> RateSwap
-> Either [Char] RateSwap
updateRateSwapRate TestDeal a
t Maybe [RateAssumption]
Nothing Date
_ RateSwap
_ = [Char] -> Either [Char] RateSwap
forall a b. a -> Either a b
Left [Char]
"Failed to update rate swap: No rate input assumption"
updateRateSwapRate TestDeal a
t (Just [RateAssumption]
rAssumps) Date
d rs :: RateSwap
rs@HE.RateSwap{ rsType :: RateSwap -> RateSwapType
HE.rsType = RateSwapType
rt } 
  = let 
      getRate :: Floater -> Either [Char] IRate
getRate Floater
x = [RateAssumption] -> Floater -> Date -> Either [Char] IRate
AP.lookupRate [RateAssumption]
rAssumps Floater
x Date
d
    in
      do  
        (IRate
pRate,IRate
rRate) <- case RateSwapType
rt of 
                              HE.FloatingToFloating Floater
flter1 Floater
flter2 ->
                                do 
                                  IRate
r1 <- Floater -> Either [Char] IRate
getRate Floater
flter1
                                  IRate
r2 <- Floater -> Either [Char] IRate
getRate Floater
flter2
                                  (IRate, IRate) -> Either [Char] (IRate, IRate)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate
r1, IRate
r2)
                              HE.FloatingToFixed Floater
flter IRate
r -> 
                                do 
                                  IRate
_r <- Floater -> Either [Char] IRate
getRate Floater
flter
                                  (IRate, IRate) -> Either [Char] (IRate, IRate)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate
_r, IRate
r)
                              HE.FixedToFloating IRate
r Floater
flter -> 
                                do 
                                  IRate
_r <- Floater -> Either [Char] IRate
getRate Floater
flter
                                  (IRate, IRate) -> Either [Char] (IRate, IRate)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate
r, IRate
_r)
                              HE.FormulaToFloating DealStats
ds Floater
flter -> 
                                do 
                                  Rate
_r <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                                  IRate
r <- Floater -> Either [Char] IRate
getRate Floater
flter
                                  (IRate, IRate) -> Either [Char] (IRate, IRate)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational Rate
_r, IRate
r)
                              HE.FloatingToFormula Floater
flter DealStats
ds -> 
                                do 
                                  IRate
r <- Floater -> Either [Char] IRate
getRate Floater
flter
                                  Rate
_r <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                                  (IRate, IRate) -> Either [Char] (IRate, IRate)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate
r, Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational Rate
_r)
        RateSwap -> Either [Char] RateSwap
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return RateSwap
rs {HE.rsPayingRate = pRate, HE.rsReceivingRate = rRate }

updateRateSwapBal :: Ast.Asset a => TestDeal a -> Date -> HE.RateSwap -> Either String HE.RateSwap
updateRateSwapBal :: forall a.
Asset a =>
TestDeal a -> Date -> RateSwap -> Either [Char] RateSwap
updateRateSwapBal TestDeal a
t Date
d rs :: RateSwap
rs@HE.RateSwap{ rsNotional :: RateSwap -> RateSwapBase
HE.rsNotional = RateSwapBase
base }
  =  case RateSwapBase
base of 
        HE.Fixed Balance
_ -> RateSwap -> Either [Char] RateSwap
forall a b. b -> Either a b
Right RateSwap
rs  
        HE.Schedule Ts
ts -> RateSwap -> Either [Char] RateSwap
forall a b. b -> Either a b
Right (RateSwap -> Either [Char] RateSwap)
-> RateSwap -> Either [Char] RateSwap
forall a b. (a -> b) -> a -> b
$ RateSwap
rs { HE.rsRefBalance = fromRational (getValByDate ts Inc d) }
        HE.Base DealStats
ds -> 
            do 
              Rate
v <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds) 
              RateSwap -> Either [Char] RateSwap
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return RateSwap
rs { HE.rsRefBalance = fromRational v} -- `debug` ("query Result"++ show (patchDateToStats d ds) )

-- ^ accure rate cap 
accrueRC :: Ast.Asset a => TestDeal a -> Date -> [RateAssumption] -> RateCap -> Either String RateCap
accrueRC :: forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> RateCap -> Either [Char] RateCap
accrueRC TestDeal a
t Date
d [RateAssumption]
rs rc :: RateCap
rc@RateCap{rcNetCash :: RateCap -> Balance
rcNetCash = Balance
amt, rcStrikeRate :: RateCap -> Ts
rcStrikeRate = Ts
strike,rcIndex :: RateCap -> Index
rcIndex = Index
index
                        ,rcStartDate :: RateCap -> Date
rcStartDate = Date
sd, rcEndDate :: RateCap -> Date
rcEndDate = Date
ed, rcNotional :: RateCap -> RateSwapBase
rcNotional = RateSwapBase
notional
                        ,rcLastStlDate :: RateCap -> Maybe Date
rcLastStlDate = Maybe Date
mlsd
                        ,rcStmt :: RateCap -> Maybe Statement
rcStmt = Maybe Statement
mstmt} 
  | Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
ed Bool -> Bool -> Bool
|| Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
sd = RateCap -> Either [Char] RateCap
forall a b. b -> Either a b
Right RateCap
rc 
  | Bool
otherwise = do
                  IRate
r <- [RateAssumption] -> Index -> Date -> Either [Char] IRate
lookupRate0 [RateAssumption]
rs Index
index Date
d
                  Rate
balance <- case RateSwapBase
notional of
                               Fixed Balance
bal -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate)
-> (Balance -> Rate) -> Balance -> Either [Char] Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Rate
forall a. Real a => a -> Rate
toRational (Balance -> Either [Char] Rate) -> Balance -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ Balance
bal
                               Base DealStats
ds -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                               Schedule Ts
ts -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate) -> Rate -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ Ts -> CutoffType -> Date -> Rate
getValByDate Ts
ts CutoffType
Inc Date
d

                  let accRate :: IRate
accRate = IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
max IRate
0 (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ IRate
r IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
- Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational (Ts -> CutoffType -> Date -> Rate
getValByDate Ts
strike CutoffType
Inc Date
d) -- `debug` ("Rate from curve"++show (getValByDate strike Inc d))
                  let addAmt :: Balance
addAmt = case Maybe Date
mlsd of 
                                 Maybe Date
Nothing -> Balance -> Date -> Date -> IRate -> DayCount -> Balance
calcInt (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
balance) Date
sd Date
d IRate
accRate DayCount
DC_ACT_365F
                                 Just Date
lstD -> Balance -> Date -> Date -> IRate -> DayCount -> Balance
calcInt (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
balance) Date
lstD Date
d IRate
accRate DayCount
DC_ACT_365F

                  let newAmt :: Balance
newAmt = Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
addAmt  -- `debug` ("Accrue AMT"++ show addAmt)
                  let newStmt :: Maybe Statement
newStmt = Txn -> Maybe Statement -> Maybe Statement
appendStmt (Date
-> Balance
-> Balance
-> IRate
-> IRate
-> Balance
-> TxnComment
-> Txn
IrsTxn Date
d Balance
newAmt Balance
addAmt IRate
0 IRate
0 Balance
0 TxnComment
SwapAccrue) Maybe Statement
mstmt 
                  RateCap -> Either [Char] RateCap
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (RateCap -> Either [Char] RateCap)
-> RateCap -> Either [Char] RateCap
forall a b. (a -> b) -> a -> b
$ RateCap
rc { rcLastStlDate = Just d ,rcNetCash = newAmt, rcStmt = newStmt }

-- ^ test if a clean up call should be fired
testCall :: Ast.Asset a => TestDeal a -> Date -> C.CallOption -> Either String Bool 
testCall :: forall a.
Asset a =>
TestDeal a -> Date -> CallOption -> Either [Char] 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 [Char] Rate -> Either [Char] Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] 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 [Char] Rate -> Either [Char] Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] 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 [Char] Rate -> Either [Char] Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] 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 [Char] Rate -> Either [Char] Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d DealStats
BondFactor
       C.OnDate Date
x -> Bool -> Either [Char] Bool
forall a b. b -> Either a b
Right (Bool -> Either [Char] Bool) -> Bool -> Either [Char] 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 [Char] Bool
forall a b. b -> Either a b
Right (Bool -> Either [Char] Bool) -> Bool -> Either [Char] 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 [Char] Bool)
-> [CallOption] -> Either [Char] Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM (TestDeal a -> Date -> CallOption -> Either [Char] Bool
forall a.
Asset a =>
TestDeal a -> Date -> CallOption -> Either [Char] Bool
testCall TestDeal a
t Date
d) [CallOption]
xs
       C.Or [CallOption]
xs -> (CallOption -> Either [Char] Bool)
-> [CallOption] -> Either [Char] Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (TestDeal a -> Date -> CallOption -> Either [Char] Bool
forall a.
Asset a =>
TestDeal a -> Date -> CallOption -> Either [Char] 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 [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
pre
       CallOption
_ -> [Char] -> Either [Char] Bool
forall a b. a -> Either a b
Left ([Char]
"failed to find call options"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CallOption -> [Char]
forall a. Show a => a -> [Char]
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 [Char] Trigger))
triggers = Maybe (Map DealCycle (Map [Char] Trigger))
trgs } DealCycle
wt 
  = case Maybe (Map DealCycle (Map [Char] Trigger))
trgs of 
      Maybe (Map DealCycle (Map [Char] Trigger))
Nothing -> []
      Just Map DealCycle (Map [Char] Trigger)
_trgs -> [Trigger]
-> (Map [Char] Trigger -> [Trigger])
-> Maybe (Map [Char] Trigger)
-> [Trigger]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Map [Char] Trigger -> [Trigger]
forall k a. Map k a -> [a]
Map.elems (Maybe (Map [Char] Trigger) -> [Trigger])
-> Maybe (Map [Char] Trigger) -> [Trigger]
forall a b. (a -> b) -> a -> b
$ DealCycle
-> Map DealCycle (Map [Char] Trigger) -> Maybe (Map [Char] Trigger)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DealCycle
wt Map DealCycle (Map [Char] Trigger)
_trgs

-- ^ execute effects of trigger: making changes to deal
-- TODO seems position of arugments can be changed : f :: a -> b -> m a  => f:: b -> a -> m a
runEffects :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent) -> Date -> TriggerEffect 
           -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent)
runEffects :: forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runEffects (t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accMap, fees :: forall a. TestDeal a -> Map [Char] Fee
fees = Map [Char] Fee
feeMap ,status :: forall a. TestDeal a -> DealStatus
status=DealStatus
st, bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds = Map [Char] Bond
bondMap, pool :: forall a. TestDeal a -> PoolType a
pool=PoolType a
pt
                      ,collects :: forall a. TestDeal a -> [CollectionRule]
collects = [CollectionRule]
collRules}, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
logs) Date
d TriggerEffect
te
  = case TriggerEffect
te of 
      DealStatusTo DealStatus
_ds -> (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t {status = _ds}, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
logs)
      DoAccrueFee FeeNames
fns -> do
                           [Fee]
newFeeList <- [Either [Char] Fee] -> Either [Char] [Fee]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Fee] -> Either [Char] [Fee])
-> [Either [Char] Fee] -> Either [Char] [Fee]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Date -> Fee -> Either [Char] Fee
forall a. Asset a => TestDeal a -> Date -> Fee -> Either [Char] Fee
calcDueFee TestDeal a
t Date
d  (Fee -> Either [Char] Fee)
-> ([Char] -> Fee) -> [Char] -> Either [Char] Fee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map [Char] Fee
feeMap Map [Char] Fee -> [Char] -> Fee
forall k a. Ord k => Map k a -> k -> a
Map.!) ([Char] -> Either [Char] Fee) -> FeeNames -> [Either [Char] Fee]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FeeNames
fns
                           let newFeeMap :: Map [Char] Fee
newFeeMap = [([Char], Fee)] -> Map [Char] Fee
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (FeeNames -> [Fee] -> [([Char], Fee)]
forall a b. [a] -> [b] -> [(a, b)]
zip FeeNames
fns [Fee]
newFeeList) Map [Char] Fee -> Map [Char] Fee -> Map [Char] Fee
forall a. Semigroup a => a -> a -> a
<> Map [Char] Fee
feeMap
                           (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t {fees = newFeeMap}, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
logs)
      ChangeReserveBalance [Char]
accName ReserveAmount
rAmt ->
          (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t {accounts = Map.adjust (set A.accTypeLens (Just rAmt)) accName accMap }
                    , RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
logs)
      
      TriggerEffects [TriggerEffect]
efs -> ((TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
 -> TriggerEffect
 -> Either
      [Char]
      (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent))
-> (TestDeal a, RunContext a, [ActionOnDate],
    DList ResultComponent)
-> [TriggerEffect]
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
`runEffects` Date
d) (TestDeal a
t, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
logs) [TriggerEffect]
efs
      
      RunActions [Action]
wActions -> do
                              (TestDeal a
newT, RunContext a
newRc, DList ResultComponent
newLogs) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t, RunContext a
rc, DList ResultComponent
forall a. DList a
DL.empty) [Action]
wActions
                              (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
newT, RunContext a
newRc, [ActionOnDate]
actions, DList ResultComponent
-> DList ResultComponent -> DList ResultComponent
forall a. DList a -> DList a -> DList a
DL.append DList ResultComponent
logs DList ResultComponent
newLogs)

      ChangeBondRate [Char]
bName InterestInfo
bRateType IRate
bRate -> 
        let 
          -- accrual rate
          -- set current rate 
          -- update rate component
          updateFn :: Bond -> Bond
updateFn Bond
b = Date -> Bond -> Bond
L.accrueInt Date
d Bond
b  
                      Bond -> (Bond -> Bond) -> Bond
forall a b. a -> (a -> b) -> b
& ASetter Bond Bond InterestInfo InterestInfo
-> InterestInfo -> Bond -> Bond
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Bond Bond InterestInfo InterestInfo
Traversal' Bond InterestInfo
L.interestInfoTraversal InterestInfo
bRateType
                      Bond -> (Bond -> Bond) -> Bond
forall a b. a -> (a -> b) -> b
& ASetter Bond Bond IRate IRate -> IRate -> Bond -> Bond
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Bond Bond IRate IRate
Traversal' Bond IRate
L.curRatesTraversal IRate
bRate 
          -- updated deal
          t' :: TestDeal a
t' = TestDeal a
t {bonds = updateBondInMap bName updateFn bondMap}
          -- build bond rate reset actions
          newActions :: [ActionOnDate]
newActions = case TestDeal a -> Bool -> [Char] -> Maybe Bond
forall a. Asset a => TestDeal a -> Bool -> [Char] -> Maybe Bond
getBondByName TestDeal a
t' Bool
True [Char]
bName of 
                        Just Bond
bnd -> [ Date -> [Char] -> ActionOnDate
ResetBondRate Date
_d [Char]
bName | Date
_d <- Bond -> Date -> Date -> [Date]
L.buildRateResetDates Bond
bnd Date
d (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ([ActionOnDate] -> ActionOnDate
forall a. HasCallStack => [a] -> a
last [ActionOnDate]
actions))]
                        Maybe Bond
Nothing -> []
        in 
          (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t' , RunContext a
rc, (ActionOnDate -> ActionOnDate -> Ordering)
-> [ActionOnDate] -> [ActionOnDate]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ActionOnDate -> ActionOnDate -> Ordering
sortActionOnDate ([ActionOnDate]
newActions[ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++[ActionOnDate]
actions), DList ResultComponent
logs) 

      TriggerEffect
DoNothing -> (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
forall a. DList a
DL.empty)
      TriggerEffect
_ -> [Char]
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. a -> Either a b
Left ([Char]
 -> Either
      [Char]
      (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent))
-> [Char]
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Failed to match trigger effects: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++TriggerEffect -> [Char]
forall a. Show a => a -> [Char]
show TriggerEffect
te

-- ^ test triggers in the deal and add a log if deal status changed
runTriggers :: Ast.Asset a => (TestDeal a, RunContext a, [ActionOnDate]) -> Date -> DealCycle -> Either String (TestDeal a, RunContext a, [ActionOnDate], DL.DList ResultComponent)
runTriggers :: forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runTriggers (t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=DealStatus
oldStatus, triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map [Char] Trigger))
triggers = Maybe (Map DealCycle (Map [Char] Trigger))
Nothing},RunContext a
rc, [ActionOnDate]
actions) Date
d DealCycle
dcycle = (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
forall a. DList a
DL.empty)
runTriggers (t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=DealStatus
oldStatus, triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map [Char] Trigger))
triggers = Just Map DealCycle (Map [Char] Trigger)
trgM},RunContext a
rc, [ActionOnDate]
actions) Date
d DealCycle
dcycle = 
  do
    let trgsMap :: Map [Char] Trigger
trgsMap = Map [Char] Trigger
-> DealCycle
-> Map DealCycle (Map [Char] Trigger)
-> Map [Char] Trigger
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map [Char] Trigger
forall k a. Map k a
Map.empty DealCycle
dcycle Map DealCycle (Map [Char] Trigger)
trgM
    let trgsToTest :: Map [Char] Trigger
trgsToTest = (Trigger -> Bool) -> Map [Char] Trigger -> Map [Char] Trigger
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter   
                           (\Trigger
trg -> (Bool -> Bool
not (Trigger -> Bool
trgStatus Trigger
trg) Bool -> Bool -> Bool
|| Trigger -> Bool
trgStatus Trigger
trg Bool -> Bool -> Bool
&& Trigger -> Bool
trgCurable Trigger
trg))
                           Map [Char] Trigger
trgsMap
    Map [Char] Trigger
triggeredTrgs <- (Trigger -> Either [Char] Trigger)
-> Map [Char] Trigger -> Either [Char] (Map [Char] Trigger)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a -> Date -> Trigger -> Either [Char] Trigger
forall a.
Asset a =>
TestDeal a -> Date -> Trigger -> Either [Char] Trigger
testTrigger TestDeal a
t Date
d) Map [Char] Trigger
trgsToTest
    let triggeredEffects :: [TriggerEffect]
triggeredEffects = [ Trigger -> TriggerEffect
trgEffects Trigger
_trg | Trigger
_trg <- Map [Char] Trigger -> [Trigger]
forall k a. Map k a -> [a]
Map.elems Map [Char] Trigger
triggeredTrgs, (Trigger -> Bool
trgStatus Trigger
_trg) ] 
    (TestDeal a
newDeal, RunContext a
newRc, [ActionOnDate]
newActions, DList ResultComponent
logsFromTrigger) <- ((TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
 -> TriggerEffect
 -> Either
      [Char]
      (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent))
-> (TestDeal a, RunContext a, [ActionOnDate],
    DList ResultComponent)
-> [TriggerEffect]
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
`runEffects` Date
d) (TestDeal a
t,RunContext a
rc,[ActionOnDate]
actions, DList ResultComponent
forall a. DList a
DL.empty) [TriggerEffect]
triggeredEffects
    let newStatus :: DealStatus
newStatus = TestDeal a -> DealStatus
forall a. TestDeal a -> DealStatus
status TestDeal a
newDeal 
    let newLogs :: DList ResultComponent
newLogs = [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d DealStatus
oldStatus DealStatus
newStatus [Char]
"By trigger"|  DealStatus
newStatus DealStatus -> DealStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= DealStatus
oldStatus] -- `debug` (">>"++show d++"trigger : new st"++ show newStatus++"old st"++show oldStatus)
    let newTriggers :: Map [Char] Trigger
newTriggers = Map [Char] Trigger -> Map [Char] Trigger -> Map [Char] Trigger
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map [Char] Trigger
triggeredTrgs Map [Char] Trigger
trgsMap
    (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
newDeal {triggers = Just (Map.insert dcycle newTriggers trgM)}
           , RunContext a
newRc
           , [ActionOnDate]
newActions
           , DList ResultComponent
-> DList ResultComponent -> DList ResultComponent
forall a. DList a -> DList a -> DList a
DL.append DList ResultComponent
newLogs DList ResultComponent
logsFromTrigger) -- `debug` ("New logs from trigger"++ show d ++">>>"++show newLogs)


changeDealStatus:: Ast.Asset a => (Date,String)-> DealStatus -> TestDeal a -> (Maybe ResultComponent, TestDeal a)
-- ^ no status change for deal already ended 
changeDealStatus :: forall a.
Asset a =>
(Date, [Char])
-> DealStatus -> TestDeal a -> (Maybe ResultComponent, TestDeal a)
changeDealStatus (Date, [Char])
_ DealStatus
_ t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=Ended Date
_} = (Maybe ResultComponent
forall a. Maybe a
Nothing, TestDeal a
t) 
changeDealStatus (Date
d,[Char]
why) DealStatus
newSt t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=DealStatus
oldSt} = (ResultComponent -> Maybe ResultComponent
forall a. a -> Maybe a
Just (Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d DealStatus
oldSt DealStatus
newSt [Char]
why), TestDeal a
t {status=newSt})



run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.PoolCashflow -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre])
        -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType)) -> DL.DList ResultComponent 
        -> Either String (TestDeal a,DL.DList ResultComponent, Map.Map PoolId CF.PoolCashflow)
run :: forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=(Ended Date
endedDate)} Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM Maybe [ActionOnDate]
ads Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t,DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log (Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
endedDate) [Char]
"By Status:Ended"), Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM)
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM (Just []) Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t,DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log (Maybe Date -> [Char] -> ResultComponent
EndRun Maybe Date
forall a. Maybe a
Nothing [Char]
"No Actions"), Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM)
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM (Just [HitStatedMaturity Date
d]) Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log (Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) [Char]
"Stop: Stated Maturity"), Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM)
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM (Just (StopRunFlag Date
d:[ActionOnDate]
_)) Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log (Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) [Char]
"Stop Run Flag"), Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM)
run t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap,fees :: forall a. TestDeal a -> Map [Char] Fee
fees=Map [Char] Fee
feeMap,triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map [Char] Trigger))
triggers=Maybe (Map DealCycle (Map [Char] Trigger))
mTrgMap,bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,status :: forall a. TestDeal a -> DealStatus
status=DealStatus
dStatus
              ,waterfall :: forall a. TestDeal a -> Map ActionWhen [Action]
waterfall=Map ActionWhen [Action]
waterfallM,name :: forall a. TestDeal a -> [Char]
name=[Char]
dealName,pool :: forall a. TestDeal a -> PoolType a
pool=PoolType a
pt,stats :: forall a.
TestDeal a
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
stats=(BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
_stat}
    Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap (Just (ActionOnDate
ad:[ActionOnDate]
ads)) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
  | Bool
futureCashToCollectFlag Bool -> Bool -> Bool
&& (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
ad) DealStats
AllAccBalance Either [Char] Rate -> Either [Char] Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right Rate
0) Bool -> Bool -> Bool
&& (DealStatus
dStatus DealStatus -> DealStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= DealStatus
Revolving) Bool -> Bool -> Bool
&& (DealStatus
dStatus DealStatus -> DealStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe DealStatus -> DealStatus
Warehousing Maybe DealStatus
forall a. Maybe a
Nothing) --TODO need to use prsim here to cover all warehouse status
     = do 
        let runContext :: RunContext a
runContext = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates --- `debug` ("ending at date " ++ show (getDate ad))
        (TestDeal a
finalDeal,RunContext a
_,DList ResultComponent
newLogs) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
ad)) (TestDeal a
t,RunContext a
runContext,DList ResultComponent
log) [Action]
cleanUpActions 
        (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
finalDeal
                , DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
newLogs (Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
ad)) [Char]
"No Pool Cashflow/All Account is zero/Not revolving")
                , Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap)

  | Bool
otherwise
    = case ActionOnDate
ad of 
        PoolCollection Date
d [Char]
_ ->
          if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) [Int]
remainCollectionNum then
            let 
              cutOffPoolFlowMap :: Map
  PoolId
  ((AssetCashflow, AssetCashflow),
   Maybe [(AssetCashflow, AssetCashflow)])
cutOffPoolFlowMap = ((AssetCashflow, Maybe [AssetCashflow])
 -> ((AssetCashflow, AssetCashflow),
     Maybe [(AssetCashflow, AssetCashflow)]))
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map
     PoolId
     ((AssetCashflow, AssetCashflow),
      Maybe [(AssetCashflow, AssetCashflow)])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(AssetCashflow
pflow,Maybe [AssetCashflow]
mAssetFlow) -> 
                                            (AssetCashflow
-> Date -> SplitType -> (AssetCashflow, AssetCashflow)
CF.splitCashFlowFrameByDate AssetCashflow
pflow Date
d SplitType
EqToLeft
                                              ,(\[AssetCashflow]
xs -> [ AssetCashflow
-> Date -> SplitType -> (AssetCashflow, AssetCashflow)
CF.splitCashFlowFrameByDate AssetCashflow
x Date
d SplitType
EqToLeft | AssetCashflow
x <- [AssetCashflow]
xs ]) ([AssetCashflow] -> [(AssetCashflow, AssetCashflow)])
-> Maybe [AssetCashflow] -> Maybe [(AssetCashflow, AssetCashflow)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [AssetCashflow]
mAssetFlow))
                                          Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap 
              collectedFlow :: Map PoolId (AssetCashflow, Maybe [AssetCashflow])
collectedFlow =  (((AssetCashflow, AssetCashflow),
  Maybe [(AssetCashflow, AssetCashflow)])
 -> (AssetCashflow, Maybe [AssetCashflow]))
-> Map
     PoolId
     ((AssetCashflow, AssetCashflow),
      Maybe [(AssetCashflow, AssetCashflow)])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\((AssetCashflow, AssetCashflow)
p,Maybe [(AssetCashflow, AssetCashflow)]
mAstFlow) -> ((AssetCashflow, AssetCashflow) -> AssetCashflow
forall a b. (a, b) -> a
fst (AssetCashflow, AssetCashflow)
p, (\[(AssetCashflow, AssetCashflow)]
xs -> [ (AssetCashflow, AssetCashflow) -> AssetCashflow
forall a b. (a, b) -> a
fst (AssetCashflow, AssetCashflow)
x | (AssetCashflow, AssetCashflow)
x <- [(AssetCashflow, AssetCashflow)]
xs ]) ([(AssetCashflow, AssetCashflow)] -> [AssetCashflow])
-> Maybe [(AssetCashflow, AssetCashflow)] -> Maybe [AssetCashflow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(AssetCashflow, AssetCashflow)]
mAstFlow)) Map
  PoolId
  ((AssetCashflow, AssetCashflow),
   Maybe [(AssetCashflow, AssetCashflow)])
cutOffPoolFlowMap  -- `debug` ("PoolCollection : "++ show d ++  " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap)
              -- outstandingFlow = Map.map (CF.insertBegTsRow d . snd) cutOffPoolFlowMap
              outstandingFlow :: Map PoolId (AssetCashflow, Maybe [AssetCashflow])
outstandingFlow = (((AssetCashflow, AssetCashflow),
  Maybe [(AssetCashflow, AssetCashflow)])
 -> (AssetCashflow, Maybe [AssetCashflow]))
-> Map
     PoolId
     ((AssetCashflow, AssetCashflow),
      Maybe [(AssetCashflow, AssetCashflow)])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\((AssetCashflow, AssetCashflow)
p,Maybe [(AssetCashflow, AssetCashflow)]
mAstFlow) -> ((AssetCashflow, AssetCashflow) -> AssetCashflow
forall a b. (a, b) -> b
snd (AssetCashflow, AssetCashflow)
p, (\[(AssetCashflow, AssetCashflow)]
xs -> [ (AssetCashflow, AssetCashflow) -> AssetCashflow
forall a b. (a, b) -> b
snd (AssetCashflow, AssetCashflow)
x | (AssetCashflow, AssetCashflow)
x <- [(AssetCashflow, AssetCashflow)]
xs ]) ([(AssetCashflow, AssetCashflow)] -> [AssetCashflow])
-> Maybe [(AssetCashflow, AssetCashflow)] -> Maybe [AssetCashflow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(AssetCashflow, AssetCashflow)]
mAstFlow)) Map
  PoolId
  ((AssetCashflow, AssetCashflow),
   Maybe [(AssetCashflow, AssetCashflow)])
cutOffPoolFlowMap  
              -- deposit cashflow to SPV from external pool cf               
            in 
              do 
                Map [Char] Account
accs <- [CollectionRule]
-> Date
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map [Char] Account
-> Either [Char] (Map [Char] Account)
depositPoolFlow (TestDeal a -> [CollectionRule]
forall a. TestDeal a -> [CollectionRule]
collects TestDeal a
t) Date
d Map PoolId (AssetCashflow, Maybe [AssetCashflow])
collectedFlow Map [Char] Account
accMap -- `debug` ("PoolCollection: deposit >>"++ show d++">>>"++ show collectedFlow++"\n")
                let dAfterDeposit :: TestDeal a
dAfterDeposit = (Date
-> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> TestDeal a
forall a.
Asset a =>
Date
-> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> TestDeal a
appendCollectedCF Date
d TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
collectedFlow) {accounts=accs}
                -- newScheduleFlowMap = Map.map (over CF.cashflowTxn (cutBy Exc Future d)) (fromMaybe Map.empty (getScheduledCashflow t Nothing))
                let newPt :: PoolType a
newPt = case (TestDeal a -> PoolType a
forall a. TestDeal a -> PoolType a
pool TestDeal a
dAfterDeposit) 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
$
				                (Pool a -> Pool a) -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
	                                          (ASetter (Pool a) (Pool a) [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> Pool a -> Identity (Pool a)
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureScheduleCf ((Maybe (AssetCashflow, Maybe [AssetCashflow])
  -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
 -> Pool a -> Identity (Pool a))
-> (([TsRow] -> Identity [TsRow])
    -> Maybe (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> ASetter (Pool a) (Pool a) [TsRow] [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((AssetCashflow, Maybe [AssetCashflow])
  -> Identity (AssetCashflow, Maybe [AssetCashflow]))
 -> Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> (([TsRow] -> Identity [TsRow])
    -> (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> ([TsRow] -> Identity [TsRow])
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetCashflow -> Identity AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  AssetCashflow
  AssetCashflow
_1 ((AssetCashflow -> Identity AssetCashflow)
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> (([TsRow] -> Identity [TsRow])
    -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> Identity [TsRow])
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn) (CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Exc DateDirection
Future Date
d)) 
                                                  Map PoolId (Pool a)
pm 
			      ResecDeal Map PoolId (UnderlyingDeal a)
dMap ->  Map PoolId (UnderlyingDeal a) -> PoolType a
forall a. Map PoolId (UnderlyingDeal a) -> PoolType a
ResecDeal Map PoolId (UnderlyingDeal a)
dMap
                let runContext :: RunContext a
runContext = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
outstandingFlow Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates  -- `debug` ("PoolCollection: before rc >>"++ show d++">>>"++ show (pool dAfterDeposit))
		(TestDeal a
dRunWithTrigger0, RunContext a
rc1, [ActionOnDate]
ads2, DList ResultComponent
newLogs0) <- (TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runTriggers (TestDeal a
dAfterDeposit {pool = newPt},RunContext a
runContext,[ActionOnDate]
ads) Date
d DealCycle
EndCollection 
                let eopActionsLog :: DList ResultComponent
eopActionsLog = [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [ Date -> ActionWhen -> ResultComponent
RunningWaterfall Date
d ActionWhen
W.EndOfPoolCollection | ActionWhen -> Map ActionWhen [Action] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member ActionWhen
W.EndOfPoolCollection Map ActionWhen [Action]
waterfallM ] -- `debug` ("new logs from trigger 1"++ show newLogs0)
                let waterfallToExe :: [Action]
waterfallToExe = [Action] -> ActionWhen -> Map ActionWhen [Action] -> [Action]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ActionWhen
W.EndOfPoolCollection (TestDeal a -> Map ActionWhen [Action]
forall a. TestDeal a -> Map ActionWhen [Action]
waterfall TestDeal a
t)  -- `debug` ("new logs from trigger 1"++ show newLogs0)
                (TestDeal a
dAfterAction,RunContext a
rc2,DList ResultComponent
newLogs) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
dRunWithTrigger0 ,RunContext a
rc1 ,DList ResultComponent
log ) [Action]
waterfallToExe  -- `debug` ("Pt 03"++ show d++">> context flow"++show (pool dRunWithTrigger0))-- `debug` ("End collection action"++ show waterfallToExe)
                (TestDeal a
dRunWithTrigger1,RunContext a
rc3,[ActionOnDate]
ads3,DList ResultComponent
newLogs1) <- (TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runTriggers (TestDeal a
dAfterAction,RunContext a
rc2,[ActionOnDate]
ads2) Date
d DealCycle
EndCollectionWF -- `debug` ("PoolCollection: Pt 04"++ show d++">> context flow"++show (runPoolFlow rc2))-- `debug` ("End collection action"++ show waterfallToExe)
                TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a -> TestDeal a
forall a. TestDeal a -> TestDeal a
increasePoolCollectedPeriod TestDeal a
dRunWithTrigger1 )
                    (RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a.
RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
runPoolFlow RunContext a
rc3) 
                    ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads3) 
                    Maybe [RateAssumption]
rates 
                    Maybe ([Pre], [Pre])
calls 
                    Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump 
                    ([DList ResultComponent] -> DList ResultComponent
forall a. [DList a] -> DList a
DL.concat [DList ResultComponent
newLogs0,DList ResultComponent
newLogs,DList ResultComponent
eopActionsLog,DList ResultComponent
newLogs1]) 
          else
            TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log 

        RunWaterfall Date
d [Char]
"" -> 
          let
            runContext :: RunContext a
runContext = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates
            waterfallKey :: ActionWhen
waterfallKey = if ActionWhen -> Map ActionWhen [Action] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (DealStatus -> ActionWhen
W.DistributionDay DealStatus
dStatus) Map ActionWhen [Action]
waterfallM then 
                              DealStatus -> ActionWhen
W.DistributionDay DealStatus
dStatus
                            else 
                              ActionWhen
W.DefaultDistribution
                        
            waterfallToExe :: [Action]
waterfallToExe = [Action] -> ActionWhen -> Map ActionWhen [Action] -> [Action]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ActionWhen
waterfallKey Map ActionWhen [Action]
waterfallM
            callTest :: [Pre]
callTest = ([Pre], [Pre]) -> [Pre]
forall a b. (a, b) -> a
fst (([Pre], [Pre]) -> [Pre]) -> ([Pre], [Pre]) -> [Pre]
forall a b. (a -> b) -> a -> b
$ ([Pre], [Pre]) -> Maybe ([Pre], [Pre]) -> ([Pre], [Pre])
forall a. a -> Maybe a -> a
fromMaybe ([]::[Pre],[]::[Pre]) Maybe ([Pre], [Pre])
calls
          in 
            do 
              (TestDeal a
dRunWithTrigger0, RunContext a
rc1, [ActionOnDate]
ads1, DList ResultComponent
newLogs0) <- (TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runTriggers (TestDeal a
t, RunContext a
runContext, [ActionOnDate]
ads) Date
d DealCycle
BeginDistributionWF 
              let logsBeforeDist :: DList ResultComponent
logsBeforeDist = [DList ResultComponent] -> DList ResultComponent
forall a. [DList a] -> DList a
DL.concat [DList ResultComponent
newLogs0 , [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [ [Char] -> ResultComponent
WarningMsg ([Char]
" No waterfall distribution found on date "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" with waterfall key "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ActionWhen -> [Char]
forall a. Show a => a -> [Char]
show ActionWhen
waterfallKey) 
                                 | ActionWhen -> Map ActionWhen [Action] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember ActionWhen
waterfallKey Map ActionWhen [Action]
waterfallM ] ]
              Bool
flag <- (Pre -> Either [Char] Bool) -> [Pre] -> Either [Char] Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
dRunWithTrigger0) [Pre]
callTest -- `debug` ( "In RunWaterfall status after before waterfall trigger >>"++ show (status dRunWithTrigger0) )
              if Bool
flag then
                do
                  let newStLogs :: [ResultComponent]
newStLogs = if [Action] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Action]
cleanUpActions then 
                                    [Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called [Char]
"Call by triggers before waterfall distribution"]
                                  else 
                                    [Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called [Char]
"Call by triggers before waterfall distribution", Date -> ActionWhen -> ResultComponent
RunningWaterfall Date
d ActionWhen
W.CleanUp]
                  (TestDeal a
dealAfterCleanUp, RunContext a
rc_, DList ResultComponent
newLogWaterfall_ ) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
dRunWithTrigger0, RunContext a
rc1,DList ResultComponent
log) [Action]
cleanUpActions 
                  DList ResultComponent
endingLogs <- TestDeal a
-> Date
-> DList ResultComponent
-> Either [Char] (DList ResultComponent)
forall a.
Asset a =>
TestDeal a
-> Date
-> DList ResultComponent
-> Either [Char] (DList ResultComponent)
Rpt.patchFinancialReports TestDeal a
dealAfterCleanUp Date
d DList ResultComponent
newLogWaterfall_
                  (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
dealAfterCleanUp, [DList ResultComponent] -> DList ResultComponent
forall a. [DList a] -> DList a
DL.concat [DList ResultComponent
logsBeforeDist,[ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList ([ResultComponent]
newStLogs[ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++[Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) [Char]
"Clean Up"]),DList ResultComponent
endingLogs], Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap) -- `debug` ("Called ! "++ show d)
              else
                do
                  (TestDeal a
dAfterWaterfall, RunContext a
rc2, DList ResultComponent
newLogsWaterfall) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
dRunWithTrigger0,RunContext a
rc1,DList ResultComponent
log) [Action]
waterfallToExe -- `debug` ("In RunWaterfall Date"++show d++">>> status "++show (status dRunWithTrigger0)++"before run waterfall collected >>"++ show (pool dRunWithTrigger0))
                  (TestDeal a
dRunWithTrigger1, RunContext a
rc3, [ActionOnDate]
ads2, DList ResultComponent
newLogs2) <- (TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runTriggers (TestDeal a
dAfterWaterfall,RunContext a
rc2,[ActionOnDate]
ads1) Date
d DealCycle
EndDistributionWF  -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall >>"++ show (runPoolFlow rc2)++" collected >>"++ show (pool dAfterWaterfall))
                  TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a -> TestDeal a
forall a. TestDeal a -> TestDeal a
increaseBondPaidPeriod TestDeal a
dRunWithTrigger1)
                      (RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a.
RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
runPoolFlow RunContext a
rc3) 
                      ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads2) 
                      Maybe [RateAssumption]
rates 
                      Maybe ([Pre], [Pre])
calls 
                      Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump 
                      ([DList ResultComponent] -> DList ResultComponent
forall a. [DList a] -> DList a
DL.concat [DList ResultComponent
newLogsWaterfall, DList ResultComponent
newLogs2 ,DList ResultComponent
logsBeforeDist,[ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [Date -> ActionWhen -> ResultComponent
RunningWaterfall Date
d ActionWhen
waterfallKey]]) -- `debug` ("In RunWaterfall Date"++show d++"after run waterfall 3>>"++ show (pool dRunWithTrigger1)++" status>>"++ show (status dRunWithTrigger1))

        -- Custom waterfall execution action from custom dates
        RunWaterfall Date
d [Char]
wName -> 
          let
            runContext :: RunContext a
runContext = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates
            waterfallKey :: ActionWhen
waterfallKey = [Char] -> ActionWhen
W.CustomWaterfall [Char]
wName
          in 
            do
              [Action]
waterfallToExe <- [Char] -> Maybe [Action] -> Either [Char] [Action]
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither
                                  ([Char]
"No waterfall distribution found on date "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" with waterfall key "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ActionWhen -> [Char]
forall a. Show a => a -> [Char]
show ActionWhen
waterfallKey) (Maybe [Action] -> Either [Char] [Action])
-> Maybe [Action] -> Either [Char] [Action]
forall a b. (a -> b) -> a -> b
$
                                  ActionWhen -> Map ActionWhen [Action] -> Maybe [Action]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ActionWhen
waterfallKey Map ActionWhen [Action]
waterfallM
              let logsBeforeDist :: [ResultComponent]
logsBeforeDist =[ [Char] -> ResultComponent
WarningMsg ([Char]
" No waterfall distribution found on date "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" with waterfall key "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ActionWhen -> [Char]
forall a. Show a => a -> [Char]
show ActionWhen
waterfallKey) 
                                        | ActionWhen -> Map ActionWhen [Action] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember ActionWhen
waterfallKey Map ActionWhen [Action]
waterfallM ]  
              (TestDeal a
dAfterWaterfall, RunContext a
rc2, DList ResultComponent
newLogsWaterfall) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t,RunContext a
runContext,DList ResultComponent
log) [Action]
waterfallToExe -- `debug` (show d ++ " running action"++ show waterfallToExe)
              TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
dAfterWaterfall (RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a.
RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
runPoolFlow RunContext a
rc2) ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump 
                  ([DList ResultComponent] -> DList ResultComponent
forall a. [DList a] -> DList a
DL.concat [DList ResultComponent
newLogsWaterfall,[ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList ([ResultComponent]
logsBeforeDist [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [Date -> ActionWhen -> ResultComponent
RunningWaterfall Date
d ActionWhen
waterfallKey])]) -- `debug` ("size of logs"++ show (length newLogsWaterfall)++ ">>"++ show d++ show (length logsBeforeDist))

        EarnAccInt Date
d [Char]
accName ->
          let 
            newAcc :: Map [Char] Account
newAcc = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Account -> Account
A.depositInt Date
d) [Char]
accName Map [Char] Account
accMap
          in 
            TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t {accounts = newAcc}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        AccrueFee Date
d [Char]
feeName -> 
          do 
            Fee
fToAcc <- [Char] -> Maybe Fee -> Either [Char] Fee
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither 
                        ([Char]
"Failed to find fee "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
feeName)
                        ([Char] -> Map [Char] Fee -> Maybe Fee
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
feeName Map [Char] Fee
feeMap)
            Fee
newF <- TestDeal a -> Date -> Fee -> Either [Char] Fee
forall a. Asset a => TestDeal a -> Date -> Fee -> Either [Char] Fee
calcDueFee TestDeal a
t Date
d Fee
fToAcc
            let newFeeMap :: Map [Char] Fee
newFeeMap = [([Char], Fee)] -> Map [Char] Fee
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [([Char]
feeName,Fee
newF)] Map [Char] Fee -> Map [Char] Fee -> Map [Char] Fee
forall a. Semigroup a => a -> a -> a
<> Map [Char] Fee
feeMap
            TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{fees=newFeeMap}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        ResetLiqProvider Date
d [Char]
liqName -> 
          case TestDeal a -> Maybe (Map [Char] LiqFacility)
forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider TestDeal a
t of 
            Maybe (Map [Char] LiqFacility)
Nothing -> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
            (Just Map [Char] LiqFacility
mLiqProvider) 
              -> let -- update credit 
                   newLiqMap :: Map [Char] LiqFacility
newLiqMap = (LiqFacility -> LiqFacility)
-> [Char] -> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (TestDeal a -> Date -> LiqFacility -> LiqFacility
forall a.
Asset a =>
TestDeal a -> Date -> LiqFacility -> LiqFacility
updateLiqProvider TestDeal a
t Date
d) [Char]
liqName Map [Char] LiqFacility
mLiqProvider
                 in
                   TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{liqProvider = Just newLiqMap}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        ResetLiqProviderRate Date
d [Char]
liqName -> 
          case TestDeal a -> Maybe (Map [Char] LiqFacility)
forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider TestDeal a
t of 
            Maybe (Map [Char] LiqFacility)
Nothing -> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
            (Just Map [Char] LiqFacility
mLiqProvider) 
              -> let -- update rate 
                   newLiqMap :: Map [Char] LiqFacility
newLiqMap = (LiqFacility -> LiqFacility)
-> [Char] -> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (TestDeal a
-> Date -> [RateAssumption] -> LiqFacility -> LiqFacility
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> LiqFacility -> LiqFacility
updateLiqProviderRate TestDeal a
t Date
d ([RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
rates)) [Char]
liqName Map [Char] LiqFacility
mLiqProvider
                 in
                   TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{liqProvider = Just newLiqMap}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        
        DealClosed Date
d ->
          let
            w :: [Action]
w = [Action] -> ActionWhen -> Map ActionWhen [Action] -> [Action]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ActionWhen
W.OnClosingDay (TestDeal a -> Map ActionWhen [Action]
forall a. TestDeal a -> Map ActionWhen [Action]
waterfall TestDeal a
t) 
            rc :: RunContext a
rc = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates  
            logForClosed :: [ResultComponent]
logForClosed =  [Date -> ActionWhen -> ResultComponent
RunningWaterfall Date
d ActionWhen
W.OnClosingDay| Bool -> Bool
not ([Action] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Action]
w)]
          in 
            do
              DealStatus
newSt <- case DealStatus
dStatus of
                         (PreClosing DealStatus
st) -> DealStatus -> Either [Char] DealStatus
forall a b. b -> Either a b
Right DealStatus
st
                         DealStatus
_ -> [Char] -> Either [Char] DealStatus
forall a b. a -> Either a b
Left ([Char] -> Either [Char] DealStatus)
-> [Char] -> Either [Char] DealStatus
forall a b. (a -> b) -> a -> b
$ [Char]
"DealClosed action is not in PreClosing status but got"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DealStatus -> [Char]
forall a. Show a => a -> [Char]
show DealStatus
dStatus
              (TestDeal a
newDeal, RunContext a
newRc, DList ResultComponent
newLog) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t, RunContext a
rc, DList ResultComponent
log) [Action]
w  -- `debug` ("ClosingDay Action:"++show w)
              TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
newDeal{status=newSt} (RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a.
RunContext a -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
runPoolFlow RunContext a
newRc) ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump 
                  ([DList ResultComponent] -> DList ResultComponent
forall a. [DList a] -> DList a
DL.concat [DList ResultComponent
newLog, [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList ([Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d (DealStatus -> DealStatus
PreClosing DealStatus
newSt) DealStatus
newSt [Char]
"By Deal Close"][ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++[ResultComponent]
logForClosed)]) -- `debug` ("new st at closing"++ show newSt)

        ChangeDealStatusTo Date
d DealStatus
s -> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{status=s}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        CalcIRSwap Date
d [Char]
sn -> 
          case TestDeal a -> Maybe (Map [Char] RateSwap)
forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap TestDeal a
t of 
            Maybe (Map [Char] RateSwap)
Nothing -> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. a -> Either a b
Left ([Char]
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ [Char]
" No rate swaps modeled when looking for "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sn
            Just Map [Char] RateSwap
rSwap ->
              do
                Map [Char] RateSwap
newRateSwap_rate <- (RateSwap -> Either [Char] RateSwap)
-> [Char]
-> Map [Char] RateSwap
-> Either [Char] (Map [Char] RateSwap)
forall k (m :: * -> *) a.
(Ord k, Applicative m) =>
(a -> m a) -> k -> Map k a -> m (Map k a)
adjustM (TestDeal a
-> Maybe [RateAssumption]
-> Date
-> RateSwap
-> Either [Char] RateSwap
forall a.
Asset a =>
TestDeal a
-> Maybe [RateAssumption]
-> Date
-> RateSwap
-> Either [Char] RateSwap
updateRateSwapRate TestDeal a
t Maybe [RateAssumption]
rates Date
d) [Char]
sn Map [Char] RateSwap
rSwap
                Map [Char] RateSwap
newRateSwap_bal <- (RateSwap -> Either [Char] RateSwap)
-> [Char]
-> Map [Char] RateSwap
-> Either [Char] (Map [Char] RateSwap)
forall k (m :: * -> *) a.
(Ord k, Applicative m) =>
(a -> m a) -> k -> Map k a -> m (Map k a)
adjustM (TestDeal a -> Date -> RateSwap -> Either [Char] RateSwap
forall a.
Asset a =>
TestDeal a -> Date -> RateSwap -> Either [Char] RateSwap
updateRateSwapBal TestDeal a
t Date
d) [Char]
sn Map [Char] RateSwap
newRateSwap_rate 
                let newRateSwap_acc :: Map [Char] RateSwap
newRateSwap_acc = (RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> RateSwap -> RateSwap
HE.accrueIRS Date
d) [Char]
sn Map [Char] RateSwap
newRateSwap_bal
                TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{rateSwap = Just newRateSwap_acc}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        SettleIRSwap Date
d [Char]
sn -> 
          case TestDeal a -> Maybe (Map [Char] RateSwap)
forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap TestDeal a
t of 
            Maybe (Map [Char] RateSwap)
Nothing -> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. a -> Either a b
Left ([Char]
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ [Char]
" No rate swaps modeled when looking for "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sn
            Just Map [Char] RateSwap
rSwap ->
              do
                Account
acc <- case RateSwap -> Maybe (RateReset, [Char])
HE.rsSettleDates (Map [Char] RateSwap
rSwap Map [Char] RateSwap -> [Char] -> RateSwap
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
sn) of 
                          Maybe (RateReset, [Char])
Nothing -> [Char] -> Either [Char] Account
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Account)
-> [Char] -> Either [Char] Account
forall a b. (a -> b) -> a -> b
$ [Char]
"No settle date found for "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sn
                          Just (RateReset
_, [Char]
_accName) -> Account -> Either [Char] Account
forall a b. b -> Either a b
Right (Account -> Either [Char] Account)
-> Account -> Either [Char] Account
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
_accName
                let accBal :: Balance
accBal = Account -> Balance
A.accBalance Account
acc
                let rs :: RateSwap
rs = Map [Char] RateSwap
rSwap Map [Char] RateSwap -> [Char] -> RateSwap
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
sn
                let settleAmt :: Balance
settleAmt = RateSwap -> Balance
HE.rsNetCash RateSwap
rs
                let accName :: [Char]
accName = Account -> [Char]
A.accName Account
acc
                case (Balance
settleAmt Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
<Balance
0, Balance
accBal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance -> Balance
forall a. Num a => a -> a
abs Balance
settleAmt) of 
                  (Bool
True, Bool
True) ->
                    let
                      newAcc :: Map [Char] Account
newAcc = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
accBal Date
d ([Char] -> TxnComment
SwapOutSettle [Char]
sn)) [Char]
accName Map [Char] Account
accMap
                      newRsMap :: Maybe (Map [Char] RateSwap)
newRsMap = Map [Char] RateSwap -> Maybe (Map [Char] RateSwap)
forall a. a -> Maybe a
Just (Map [Char] RateSwap -> Maybe (Map [Char] RateSwap))
-> Map [Char] RateSwap -> Maybe (Map [Char] RateSwap)
forall a b. (a -> b) -> a -> b
$ (RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Balance -> RateSwap -> RateSwap
HE.payoutIRS Date
d Balance
accBal) [Char]
sn Map [Char] RateSwap
rSwap 
                    in 
                      TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{accounts = newAcc, rateSwap = newRsMap}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump
                      (DList ResultComponent
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log ([Char] -> ResultComponent
WarningMsg ([Char] -> ResultComponent) -> [Char] -> ResultComponent
forall a b. (a -> b) -> a -> b
$ [Char]
"Settle Rate Swap Error: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Insufficient balance to settle "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sn)
                    -- Left $ "Settle Rate Swap Error: "++ show d ++" Insufficient balance to settle "++ sn
                  (Bool
True, Bool
False) -> 
                    let
                      newAcc :: Map [Char] Account
newAcc = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw (Balance -> Balance
forall a. Num a => a -> a
abs Balance
settleAmt) Date
d ([Char] -> TxnComment
SwapOutSettle [Char]
sn)) [Char]
accName  Map [Char] Account
accMap
                      newRsMap :: Maybe (Map [Char] RateSwap)
newRsMap = Map [Char] RateSwap -> Maybe (Map [Char] RateSwap)
forall a. a -> Maybe a
Just (Map [Char] RateSwap -> Maybe (Map [Char] RateSwap))
-> Map [Char] RateSwap -> Maybe (Map [Char] RateSwap)
forall a b. (a -> b) -> a -> b
$ (RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Balance -> RateSwap -> RateSwap
HE.payoutIRS Date
d Balance
settleAmt) [Char]
sn Map [Char] RateSwap
rSwap 
                    in 
                      TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{accounts = newAcc, rateSwap = newRsMap}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
                  (Bool
False, Bool
_) -> 
                    let 
                      newAcc :: Map [Char] Account
newAcc = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
settleAmt Date
d ([Char] -> TxnComment
SwapInSettle [Char]
sn)) [Char]
accName Map [Char] Account
accMap
                      newRsMap :: Maybe (Map [Char] RateSwap)
newRsMap = Map [Char] RateSwap -> Maybe (Map [Char] RateSwap)
forall a. a -> Maybe a
Just (Map [Char] RateSwap -> Maybe (Map [Char] RateSwap))
-> Map [Char] RateSwap -> Maybe (Map [Char] RateSwap)
forall a b. (a -> b) -> a -> b
$ (RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> RateSwap -> RateSwap
HE.receiveIRS Date
d) [Char]
sn Map [Char] RateSwap
rSwap 
                    in
                      TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{accounts = newAcc, rateSwap = newRsMap}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        AccrueCapRate Date
d [Char]
cn -> 
          case TestDeal a -> Maybe (Map [Char] RateCap)
forall a. TestDeal a -> Maybe (Map [Char] RateCap)
rateCap TestDeal a
t of 
            Maybe (Map [Char] RateCap)
Nothing -> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. a -> Either a b
Left ([Char]
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ [Char]
" No rate cap found for "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cn
            Just Map [Char] RateCap
rCap ->
              let
                _rates :: [RateAssumption]
_rates = [RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
rates
              in 
                do 
                  Map [Char] RateCap
newRateCap <- (RateCap -> Either [Char] RateCap)
-> [Char]
-> Map [Char] RateCap
-> Either [Char] (Map [Char] RateCap)
forall k (m :: * -> *) a.
(Ord k, Applicative m) =>
(a -> m a) -> k -> Map k a -> m (Map k a)
adjustM (TestDeal a
-> Date -> [RateAssumption] -> RateCap -> Either [Char] RateCap
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> RateCap -> Either [Char] RateCap
accrueRC TestDeal a
t Date
d [RateAssumption]
_rates) [Char]
cn Map [Char] RateCap
rCap
                  TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a
t{rateCap = Just newRateCap}) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        InspectDS Date
d [DealStats]
dss -> 
          do
            [ResultComponent]
newlog <- TestDeal a
-> Date -> [DealStats] -> Either [Char] [ResultComponent]
forall a.
Asset a =>
TestDeal a
-> Date -> [DealStats] -> Either [Char] [ResultComponent]
inspectListVars TestDeal a
t Date
d [DealStats]
dss 
            TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ DList ResultComponent
-> DList ResultComponent -> DList ResultComponent
forall a. DList a -> DList a -> DList a
DL.append DList ResultComponent
log ([ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [ResultComponent]
newlog) -- `debug` ("Add log"++show newlog)
        
        ResetBondRate Date
d [Char]
bn  -> 
          let 
            rateList :: [RateAssumption]
rateList = [RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
rates
            bnd :: Bond
bnd = Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bn
          in 
            do 
              Bond
newBnd <- TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
rateList Bond
bnd 
              TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t{bonds = Map.fromList [(bn,newBnd)] <> bndMap} Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        
        StepUpBondRate Date
d [Char]
bn -> 
          let 
            bnd :: Bond
bnd = Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bn -- `debug` ("StepUpBondRate--------------"++ show bn)
          in 
            do 
              -- newBnd <- setBondStepUpRate t d bnd `debug` ("StepUpBondRate"++ show d++ show bn)
              Map [Char] Bond
newBndMap <- (Bond -> Either [Char] Bond)
-> [Char] -> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall k (m :: * -> *) a.
(Ord k, Applicative m) =>
(a -> m a) -> k -> Map k a -> m (Map k a)
adjustM (TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either [Char] Bond
setBondStepUpRate TestDeal a
t Date
d ([RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
rates)) [Char]
bn Map [Char] Bond
bndMap
              TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t{bonds = newBndMap } Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        
        ResetAccRate Date
d [Char]
accName -> 
          do
            Map [Char] Account
newAccMap <- (Account -> Either [Char] Account)
-> [Char]
-> Map [Char] Account
-> Either [Char] (Map [Char] Account)
forall k (m :: * -> *) a.
(Ord k, Applicative m) =>
(a -> m a) -> k -> Map k a -> m (Map k a)
adjustM 
                          (\a :: Account
a@(A.Account Balance
_ [Char]
_ (Just (A.InvestmentAccount Index
idx IRate
spd RateReset
dp RateReset
dp1 Date
lastDay IRate
_)) Maybe ReserveAmount
_ Maybe Statement
_)
                            -> do
                                 IRate
newRate <- [RateAssumption] -> Floater -> Date -> Either [Char] IRate
AP.lookupRate ([RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
rates) (Index
idx,IRate
spd) Date
d 
                                 let accWithNewInt :: Account
accWithNewInt = Date -> Account -> Account
A.depositInt Date
d Account
a
                                 Account -> Either [Char] Account
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Account
accWithNewInt { A.accInterest = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)})
                          [Char]
accName Map [Char] Account
accMap
            TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t{accounts = newAccMap} Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        BuildReport Date
sd Date
ed ->
          let 
            cashReport :: CashflowReport
cashReport = TestDeal a -> Date -> Date -> CashflowReport
forall a. Asset a => TestDeal a -> Date -> Date -> CashflowReport
Rpt.buildCashReport TestDeal a
t Date
sd Date
ed 
          in 
            do 
              BalanceSheetReport
bsReport <- TestDeal a -> Date -> Either [Char] BalanceSheetReport
forall a.
Asset a =>
TestDeal a -> Date -> Either [Char] BalanceSheetReport
Rpt.buildBalanceSheet TestDeal a
t Date
ed
              let newlog :: ResultComponent
newlog = Date
-> Date -> BalanceSheetReport -> CashflowReport -> ResultComponent
FinancialReport Date
sd Date
ed BalanceSheetReport
bsReport CashflowReport
cashReport
              TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log ResultComponent
newlog -- `debug` ("new log"++ show ed++ show newlog)

        FireTrigger Date
d DealCycle
cyc [Char]
n -> 
          let 
            triggerFired :: Map DealCycle (Map [Char] Trigger)
triggerFired = case Maybe (Map DealCycle (Map [Char] Trigger))
mTrgMap of 
                               Maybe (Map DealCycle (Map [Char] Trigger))
Nothing -> [Char] -> Map DealCycle (Map [Char] Trigger)
forall a. HasCallStack => [Char] -> a
error [Char]
"trigger is empty for override" 
                               Just Map DealCycle (Map [Char] Trigger)
tm -> (Map [Char] Trigger -> Map [Char] Trigger)
-> DealCycle
-> Map DealCycle (Map [Char] Trigger)
-> Map DealCycle (Map [Char] Trigger)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Trigger -> Trigger)
-> [Char] -> Map [Char] Trigger -> Map [Char] Trigger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (ASetter Trigger Trigger Bool Bool -> Bool -> Trigger -> Trigger
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Trigger Trigger Bool Bool
Lens' Trigger Bool
trgStatusLens Bool
True) [Char]
n) DealCycle
cyc Map DealCycle (Map [Char] Trigger)
tm
            triggerEffects :: Maybe TriggerEffect
triggerEffects = do
                                Map DealCycle (Map [Char] Trigger)
tm <- Maybe (Map DealCycle (Map [Char] Trigger))
mTrgMap
                                Map [Char] Trigger
cycM <- DealCycle
-> Map DealCycle (Map [Char] Trigger) -> Maybe (Map [Char] Trigger)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DealCycle
cyc Map DealCycle (Map [Char] Trigger)
tm
                                Trigger
trg <- [Char] -> Map [Char] Trigger -> Maybe Trigger
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
n Map [Char] Trigger
cycM
                                TriggerEffect -> Maybe TriggerEffect
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TriggerEffect -> Maybe TriggerEffect)
-> TriggerEffect -> Maybe TriggerEffect
forall a b. (a -> b) -> a -> b
$ Trigger -> TriggerEffect
trgEffects Trigger
trg
            
            runContext :: RunContext a
runContext = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates
          in 
            do 
              (TestDeal a
newT, rc :: RunContext a
rc@(RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
newPool Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
_ Maybe [RateAssumption]
_), [ActionOnDate]
adsFromTrigger, DList ResultComponent
newLogsFromTrigger) 
                <- case Maybe TriggerEffect
triggerEffects of 
                    Maybe TriggerEffect
Nothing -> (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t, RunContext a
runContext, [ActionOnDate]
ads, DList ResultComponent
forall a. DList a
DL.empty) -- `debug` "Nothing found on effects"
                    Just TriggerEffect
efs -> (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     [Char]
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runEffects (TestDeal a
t, RunContext a
runContext, [ActionOnDate]
ads, DList ResultComponent
forall a. DList a
DL.empty) Date
d TriggerEffect
efs
              let (DealStatus
oldStatus,DealStatus
newStatus) = (TestDeal a -> DealStatus
forall a. TestDeal a -> DealStatus
status TestDeal a
t,TestDeal a -> DealStatus
forall a. TestDeal a -> DealStatus
status TestDeal a
newT)
              let stChangeLogs :: DList ResultComponent
stChangeLogs = [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d DealStatus
oldStatus DealStatus
newStatus [Char]
"by Manual fireTrigger" |  DealStatus
oldStatus DealStatus -> DealStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= DealStatus
newStatus] 
              TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
newT {triggers = Just triggerFired} Map PoolId (AssetCashflow, Maybe [AssetCashflow])
newPool ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ [DList ResultComponent] -> DList ResultComponent
forall a. [DList a] -> DList a
DL.concat [DList ResultComponent
log,DList ResultComponent
stChangeLogs,DList ResultComponent
newLogsFromTrigger]
        
        MakeWhole Date
d IRate
spd Table Float IRate
walTbl -> 
            let 
              schedulePoolFlowMap :: Map PoolId AssetCashflow
schedulePoolFlowMap = case PoolType a
pt of 
				      MultiPool Map PoolId (Pool a)
pMap -> (Pool a -> AssetCashflow)
-> Map PoolId (Pool a) -> Map PoolId AssetCashflow
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Getting AssetCashflow (Pool a) AssetCashflow
-> Pool a -> AssetCashflow
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Const
      AssetCashflow (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> Pool a -> Const AssetCashflow (Pool a)
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureScheduleCf((Maybe (AssetCashflow, Maybe [AssetCashflow])
  -> Const
       AssetCashflow (Maybe (AssetCashflow, Maybe [AssetCashflow])))
 -> Pool a -> Const AssetCashflow (Pool a))
-> ((AssetCashflow -> Const AssetCashflow AssetCashflow)
    -> Maybe (AssetCashflow, Maybe [AssetCashflow])
    -> Const
         AssetCashflow (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> Getting AssetCashflow (Pool a) AssetCashflow
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((AssetCashflow, Maybe [AssetCashflow])
 -> Const AssetCashflow (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Const
     AssetCashflow (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just(((AssetCashflow, Maybe [AssetCashflow])
  -> Const AssetCashflow (AssetCashflow, Maybe [AssetCashflow]))
 -> Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Const
      AssetCashflow (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> ((AssetCashflow -> Const AssetCashflow AssetCashflow)
    -> (AssetCashflow, Maybe [AssetCashflow])
    -> Const AssetCashflow (AssetCashflow, Maybe [AssetCashflow]))
-> (AssetCashflow -> Const AssetCashflow AssetCashflow)
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Const
     AssetCashflow (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AssetCashflow -> Const AssetCashflow AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Const AssetCashflow (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  AssetCashflow
  AssetCashflow
_1) ) Map PoolId (Pool a)
pMap 
				      ResecDeal Map PoolId (UnderlyingDeal a)
uDealMap -> (UnderlyingDeal a -> AssetCashflow)
-> Map PoolId (UnderlyingDeal a) -> Map PoolId AssetCashflow
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Getting AssetCashflow (UnderlyingDeal a) AssetCashflow
-> UnderlyingDeal a -> AssetCashflow
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AssetCashflow (UnderlyingDeal a) AssetCashflow
forall a. Asset a => Lens' (UnderlyingDeal a) AssetCashflow
Lens' (UnderlyingDeal a) AssetCashflow
uDealFutureScheduleCf) Map PoolId (UnderlyingDeal a)
uDealMap
            in 
              do 
                Rate
factor <- (Rate -> Rate -> Rate)
-> Either [Char] Rate -> Either [Char] Rate -> Either [Char] Rate
forall a b c.
(a -> b -> c)
-> Either [Char] a -> Either [Char] b -> Either [Char] c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
                            Rate -> Rate -> Rate
forall a. Fractional a => a -> a -> a
(/)
                            (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Maybe [PoolId] -> DealStats
FutureCurrentPoolBegBalance Maybe [PoolId]
forall a. Maybe a
Nothing)) 
                            (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Maybe [PoolId] -> DealStats
FutureCurrentSchedulePoolBegBalance Maybe [PoolId]
forall a. Maybe a
Nothing))
                let reduceCfs :: Map PoolId (AssetCashflow, Maybe [AssetCashflow])
reduceCfs = (AssetCashflow -> (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId AssetCashflow
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\AssetCashflow
f -> ((([TsRow] -> Identity [TsRow])
 -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> [TsRow]) -> AssetCashflow -> AssetCashflow
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn (\[TsRow]
xs -> Rate -> TsRow -> TsRow
CF.scaleTsRow Rate
factor (TsRow -> TsRow) -> [TsRow] -> [TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
xs) AssetCashflow
f, Maybe [AssetCashflow]
forall a. Maybe a
Nothing ) ) Map PoolId AssetCashflow
schedulePoolFlowMap -- need to apply with factor and trucate with date
                (TestDeal a
runDealWithSchedule,DList ResultComponent
_,Map PoolId (AssetCashflow, Maybe [AssetCashflow])
_) <- TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
reduceCfs ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
                let bondWal :: Map [Char] Rate
bondWal = (Bond -> Rate) -> Map [Char] Bond -> Map [Char] Rate
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Date -> Bond -> Rate
L.calcWalBond Date
d) (TestDeal a -> Map [Char] Bond
forall a. TestDeal a -> Map [Char] Bond
bonds TestDeal a
runDealWithSchedule) -- `debug` ("Bond schedule flow"++ show (bonds runDealWithSchedule))
                let bondSprd :: Map [Char] IRate
bondSprd = (Rate -> IRate) -> Map [Char] Rate -> Map [Char] IRate
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                 (\Rate
x -> (IRate
spd IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ (IRate -> Maybe IRate -> IRate
forall a. a -> Maybe a -> a
fromMaybe IRate
0 (Table Float IRate -> Direction -> (Float -> Bool) -> Maybe IRate
forall a b.
Ord a =>
Table a b -> Direction -> (a -> Bool) -> Maybe b
lookupTable Table Float IRate
walTbl Direction
Up (Rate -> Float
forall a. Fractional a => Rate -> a
fromRational Rate
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>)))))
                                 Map [Char] Rate
bondWal 
                let bondPricingCurve :: Map [Char] Ts
bondPricingCurve = (IRate -> Ts) -> Map [Char] IRate -> Map [Char] Ts
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                         (\IRate
x -> [TsPoint IRate] -> Ts
IRateCurve [ Date -> IRate -> TsPoint IRate
forall a. Date -> a -> TsPoint a
TsPoint Date
d IRate
x,Date -> IRate -> TsPoint IRate
forall a. Date -> a -> TsPoint a
TsPoint (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ([ActionOnDate] -> ActionOnDate
forall a. HasCallStack => [a] -> a
last [ActionOnDate]
ads)) IRate
x] )
                                         Map [Char] IRate
bondSprd 
                let bondPricingResult :: Map [Char] PriceResult
bondPricingResult = ([Char] -> Bond -> Ts -> PriceResult)
-> Map [Char] Bond -> Map [Char] Ts -> Map [Char] PriceResult
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey (\[Char]
k Bond
v1 Ts
v2 -> Date -> Ts -> Bond -> PriceResult
L.priceBond Date
d Ts
v2 Bond
v1) (TestDeal a -> Map [Char] Bond
forall a. TestDeal a -> Map [Char] Bond
bonds TestDeal a
runDealWithSchedule) Map [Char] Ts
bondPricingCurve 
                let depositBondFlow :: Map [Char] Bond
depositBondFlow = (Bond -> PriceResult -> Bond)
-> Map [Char] Bond -> Map [Char] PriceResult -> Map [Char] Bond
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
                                        (\Bond
bnd (PriceResult Balance
pv IRate
_ Balance
_ IRate
_ IRate
_ Balance
_ [Txn]
_) -> 
                                          let 
                                            ostBal :: Balance
ostBal = Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getCurBalance Bond
bnd
                                            prinToPay :: Balance
prinToPay = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
pv Balance
ostBal
                                            intToPay :: Balance
intToPay = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
max Balance
0 (Balance
pv Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
prinToPay)
                                            bnd1 :: Bond
bnd1 = Date -> Balance -> Bond -> Bond
L.payPrin Date
d Balance
prinToPay Bond
bnd
                                          in 
                                            Date -> Balance -> Bond -> Bond
L.payYield Date
d Balance
intToPay Bond
bnd1)
                                        (TestDeal a -> Map [Char] Bond
forall a. TestDeal a -> Map [Char] Bond
bonds TestDeal a
t)
                                        Map [Char] PriceResult
bondPricingResult
                TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t {bonds = depositBondFlow, status = Ended d} Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall k a. Map k a
Map.empty ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just []) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log (Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) [Char]
"MakeWhole call")
        
        FundBond Date
d Maybe Pre
Nothing [Char]
bName [Char]
accName Balance
fundAmt ->
          let 
            newAcc :: Map [Char] Account
newAcc = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
fundAmt Date
d ([Char] -> Balance -> TxnComment
FundWith [Char]
bName Balance
fundAmt)) [Char]
accName Map [Char] Account
accMap
          in 
            do
              let bndFunded :: Bond
bndFunded = Date -> Balance -> Bond -> Bond
L.fundWith Date
d Balance
fundAmt (Bond -> Bond) -> Bond -> Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bName
              TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap}
                  Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        FundBond Date
d (Just Pre
p) [Char]
bName [Char]
accName Balance
fundAmt ->
          let 
            newAcc :: Map [Char] Account
newAcc = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
fundAmt Date
d ([Char] -> Balance -> TxnComment
FundWith [Char]
bName Balance
fundAmt)) [Char]
accName Map [Char] Account
accMap
          in 
            do
              Bool
flag <- Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
p
              case Bool
flag of
                Bool
False -> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log ([Char] -> ResultComponent
WarningMsg ([Char]
"Failed to fund bond"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Pre -> [Char]
forall a. Show a => a -> [Char]
show Pre
p)))
                Bool
True -> 
                  do
                    let bndFunded :: Bond
bndFunded = Date -> Balance -> Bond -> Bond
L.fundWith Date
d Balance
fundAmt (Bond -> Bond) -> Bond -> Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bName
                    TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap}
                        Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
          

        IssueBond Date
d Maybe Pre
Nothing [Char]
bGroupName [Char]
accName Bond
bnd Maybe DealStats
mBal Maybe DealStats
mRate -> 
           TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just ((Date
-> Maybe Pre
-> [Char]
-> [Char]
-> Bond
-> Maybe DealStats
-> Maybe DealStats
-> ActionOnDate
IssueBond Date
d (Pre -> Maybe Pre
forall a. a -> Maybe a
Just (Bool -> Pre
Always Bool
True)) [Char]
bGroupName [Char]
accName Bond
bnd Maybe DealStats
mBal Maybe DealStats
mRate)ActionOnDate -> [ActionOnDate] -> [ActionOnDate]
forall a. a -> [a] -> [a]
:[ActionOnDate]
ads)) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        
        IssueBond Date
d (Just Pre
p) [Char]
bGroupName [Char]
accName Bond
bnd Maybe DealStats
mBal Maybe DealStats
mRate ->
            do 
              Bool
flag <- Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
p
              case Bool
flag of
                Bool
False -> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log ([Char] -> ResultComponent
WarningMsg ([Char]
"Failed to issue to bond group"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bGroupName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Pre -> [Char]
forall a. Show a => a -> [Char]
show Pre
p)))
                Bool
True -> let 
                          newBndName :: [Char]
newBndName = Bond -> [Char]
L.bndName Bond
bnd
                        in
                           do
                             Rate
newBalance <- case Maybe DealStats
mBal of
                                             Just DealStats
_q -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
_q)  
                                             Maybe DealStats
Nothing -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate)
-> (Balance -> Rate) -> Balance -> Either [Char] Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Rate
forall a. Real a => a -> Rate
toRational (Balance -> Either [Char] Rate) -> Balance -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ OriginalInfo -> Balance
L.originBalance (Bond -> OriginalInfo
L.bndOriginInfo Bond
bnd)
                             Rate
newRate <- case Maybe DealStats
mRate of 
                                         Just DealStats
_q -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
_q)
                                         Maybe DealStats
Nothing -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate) -> Rate -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ OriginalInfo -> Rate
L.originRate (Bond -> OriginalInfo
L.bndOriginInfo Bond
bnd)
                             let newBonds :: Map [Char] Bond
newBonds = case [Char] -> Map [Char] Bond -> Maybe Bond
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
bGroupName Map [Char] Bond
bndMap of
                                              Maybe Bond
Nothing -> Map [Char] Bond
bndMap
                                              Just L.Bond {} -> Map [Char] Bond
bndMap
                                              Just (L.BondGroup Map [Char] Bond
bndGrpMap Maybe BondType
pt) -> let
                                                                                bndOInfo :: OriginalInfo
bndOInfo = (Bond -> OriginalInfo
L.bndOriginInfo Bond
bnd) {L.originDate = d, L.originRate = newRate, L.originBalance = fromRational newBalance }
                                                                                bndToInsert :: Bond
bndToInsert = Bond
bnd {L.bndOriginInfo = bndOInfo,
                                                                                                   L.bndDueIntDate = Just d,
                                                                                                   L.bndLastIntPay = Just d, 
                                                                                                   L.bndLastPrinPay = Just d,
                                                                                                   L.bndRate = fromRational newRate,
                                                                                                   L.bndBalance = fromRational newBalance}
                                                                              in 
                                                                                [Char] -> Bond -> Map [Char] Bond -> Map [Char] Bond
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
bGroupName 
                                                                                           (Map [Char] Bond -> Maybe BondType -> Bond
L.BondGroup ([Char] -> Bond -> Map [Char] Bond -> Map [Char] Bond
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
newBndName Bond
bndToInsert Map [Char] Bond
bndGrpMap) Maybe BondType
pt)
                                                                                           Map [Char] Bond
bndMap

                             let issuanceProceeds :: Balance
issuanceProceeds = Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
newBalance
                             let newAcc :: Map [Char] Account
newAcc = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
issuanceProceeds Date
d ([Char] -> TxnComment
IssuanceProceeds [Char]
newBndName))
                                                     [Char]
accName
                                                     Map [Char] Account
accMap
                             TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t{bonds = newBonds, accounts = newAcc} Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        RefiBondRate Date
d [Char]
accName [Char]
bName InterestInfo
iInfo ->
           let
             -- settle accrued interest 
             -- TODO rebuild bond rate reset actions
             lstDate :: Date
lstDate = ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ([ActionOnDate] -> ActionOnDate
forall a. HasCallStack => [a] -> a
last [ActionOnDate]
ads)
             isResetActionEvent :: ActionOnDate -> Bool
isResetActionEvent (ResetBondRate Date
_ [Char]
bName ) = Bool
False 
             isResetActionEvent ActionOnDate
_ = Bool
True
             filteredAds :: [ActionOnDate]
filteredAds = (ActionOnDate -> Bool) -> [ActionOnDate] -> [ActionOnDate]
forall a. (a -> Bool) -> [a] -> [a]
filter ActionOnDate -> Bool
isResetActionEvent [ActionOnDate]
ads
             newRate :: IRate
newRate = InterestInfo -> IRate
L.getBeginRate InterestInfo
iInfo
          in 
             do 
               Bond
nBnd <- TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bName
               let dueIntToPay :: Balance
dueIntToPay = Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt Bond
nBnd
               let ((Balance
shortfall,Balance
drawAmt),Account
newAcc) = Balance
-> Date -> TxnComment -> Account -> ((Balance, Balance), Account)
A.tryDraw Balance
dueIntToPay Date
d (FeeNames -> TxnComment
PayInt [[Char]
bName]) (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
accName)
               let newBnd :: Bond
newBnd = ASetter Bond Bond InterestInfo InterestInfo
-> InterestInfo -> Bond -> Bond
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Bond Bond InterestInfo InterestInfo
Traversal' Bond InterestInfo
L.bndIntLens InterestInfo
iInfo (Bond -> Bond) -> Bond -> Bond
forall a b. (a -> b) -> a -> b
$ Date -> Balance -> Bond -> Bond
L.payInt Date
d Balance
drawAmt Bond
nBnd
               let resetDates :: [Date]
resetDates = Bond -> Date -> Date -> [Date]
L.buildRateResetDates Bond
newBnd Date
d Date
lstDate 
               -- let bResetActions = [ ResetBondRate d bName 0 | d <- resetDates ]
               -- TODO tobe fix
               let bResetActions :: [a]
bResetActions = []
               let newAccMap :: Map [Char] Account
newAccMap = [Char] -> Account -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
accName Account
newAcc Map [Char] Account
accMap
               let newBndMap :: Map [Char] Bond
newBndMap = [Char] -> Bond -> Map [Char] Bond -> Map [Char] Bond
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
bName (Bond
newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d ,L.bndLastIntPay = Just d}) Map [Char] Bond
bndMap
               let newAds :: [ActionOnDate]
newAds = (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
$ [ActionOnDate]
filteredAds [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ [ActionOnDate]
forall a. [a]
bResetActions
               TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t{bonds = newBndMap, accounts = newAccMap} Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
newAds) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
           
        RefiBond Date
d [Char]
accName Bond
bnd -> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. a -> Either a b
Left [Char]
"Undefined action: RefiBond"

        TestCall Date
d ->
          let 
            [Pre]
timeBasedTests::[Pre] = ([Pre], [Pre]) -> [Pre]
forall a b. (a, b) -> b
snd (([Pre], [Pre]) -> Maybe ([Pre], [Pre]) -> ([Pre], [Pre])
forall a. a -> Maybe a -> a
fromMaybe ([],[]) Maybe ([Pre], [Pre])
calls)
          in
            do 
              [Bool]
flags::[Bool] <- [Either [Char] Bool] -> Either [Char] [Bool]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Bool] -> Either [Char] [Bool])
-> [Either [Char] Bool] -> Either [Char] [Bool]
forall a b. (a -> b) -> a -> b
$ [ (Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
pre) | Pre
pre <- [Pre]
timeBasedTests ]
              case (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bool -> Bool
forall a. a -> a
id [Bool]
flags of
                Bool
True -> 
                  let 
                     runContext :: RunContext a
runContext = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates
                     newStLogs :: DList ResultComponent
newStLogs = if [Action] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Action]
cleanUpActions then 
                                   [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called [Char]
"by Date-Based Call"]
                                 else 
                                   [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [Date -> DealStatus -> DealStatus -> [Char] -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called [Char]
"by Date-Based Call", Date -> ActionWhen -> ResultComponent
RunningWaterfall Date
d ActionWhen
W.CleanUp]
                  in  
                     do 
                       (TestDeal a
dealAfterCleanUp, RunContext a
rc_, DList ResultComponent
newLogWaterfall_ ) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t, RunContext a
runContext, DList ResultComponent
log) [Action]
cleanUpActions
                       DList ResultComponent
endingLogs <- TestDeal a
-> Date
-> DList ResultComponent
-> Either [Char] (DList ResultComponent)
forall a.
Asset a =>
TestDeal a
-> Date
-> DList ResultComponent
-> Either [Char] (DList ResultComponent)
Rpt.patchFinancialReports TestDeal a
dealAfterCleanUp Date
d DList ResultComponent
newLogWaterfall_
                       (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
dealAfterCleanUp, DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc (DList ResultComponent
endingLogs DList ResultComponent
-> DList ResultComponent -> DList ResultComponent
forall a. DList a -> DList a -> DList a
`DL.append` DList ResultComponent
newStLogs) (Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) [Char]
"Clean Up"), Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap) -- `debug` ("Called ! "++ show d)
                Bool
_ -> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        StopRunTest Date
d [Pre]
pres -> 
	  do
            [Bool]
flags::[Bool] <- [Either [Char] Bool] -> Either [Char] [Bool]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Bool] -> Either [Char] [Bool])
-> [Either [Char] Bool] -> Either [Char] [Bool]
forall a b. (a -> b) -> a -> b
$ [ (Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
pre) | Pre
pre <- [Pre]
pres ]
            case (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id [Bool]
flags of
	      Bool
True -> (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
log (Maybe Date -> [Char] -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) ([Char]
"Stop Run Test by:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [(Pre, Bool)] -> [Char]
forall a. Show a => a -> [Char]
show ([Pre] -> [Bool] -> [(Pre, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Pre]
pres [Bool]
flags))), Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap)
	      Bool
_ -> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log


        ActionOnDate
_ -> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. a -> Either a b
Left ([Char]
 -> Either
      [Char]
      (TestDeal a, DList ResultComponent,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> [Char]
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to match action on Date"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ActionOnDate -> [Char]
forall a. Show a => a -> [Char]
show ActionOnDate
ad

       where
         cleanUpActions :: [Action]
cleanUpActions = [Action] -> ActionWhen -> Map ActionWhen [Action] -> [Action]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ActionWhen
W.CleanUp (TestDeal a -> Map ActionWhen [Action]
forall a. TestDeal a -> Map ActionWhen [Action]
waterfall TestDeal a
t) -- `debug` ("Running AD"++show(ad))
         remainCollectionNum :: [Int]
remainCollectionNum = Map PoolId Int -> [Int]
forall k a. Map k a -> [a]
Map.elems (Map PoolId Int -> [Int]) -> Map PoolId Int -> [Int]
forall a b. (a -> b) -> a -> b
$ ((AssetCashflow, Maybe [AssetCashflow]) -> Int)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(AssetCashflow
x,Maybe [AssetCashflow]
_) -> AssetCashflow -> Int
CF.sizeCashFlowFrame AssetCashflow
x ) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap
         futureCashToCollectFlag :: Bool
futureCashToCollectFlag = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Map PoolId Bool -> [Bool]
forall k a. Map k a -> [a]
Map.elems (Map PoolId Bool -> [Bool]) -> Map PoolId Bool -> [Bool]
forall a b. (a -> b) -> a -> b
$ ((AssetCashflow, Maybe [AssetCashflow]) -> Bool)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId Bool
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(AssetCashflow
pcf,Maybe [AssetCashflow]
_) -> (TsRow -> Bool) -> [TsRow] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TsRow -> Bool
CF.isEmptyRow2 (Getting [TsRow] AssetCashflow [TsRow] -> AssetCashflow -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] AssetCashflow [TsRow]
Lens' AssetCashflow [TsRow]
CF.cashflowTxn AssetCashflow
pcf)) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowMap


run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
empty Maybe [ActionOnDate]
Nothing Maybe [RateAssumption]
Nothing Maybe ([Pre], [Pre])
Nothing Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
Nothing DList ResultComponent
log
  = do
      (TestDeal a
t, [ActionOnDate]
ads, Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pcf, Map PoolId (AssetCashflow, Maybe [AssetCashflow])
unStressPcf) <- Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, [ActionOnDate],
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]),
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, [ActionOnDate],
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]),
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
getInits Set ExpectReturn
forall a. Set a
S.empty TestDeal a
t Maybe ApplyAssumptionType
forall a. Maybe a
Nothing Maybe NonPerfAssumption
forall a. Maybe a
Nothing 
      TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pcf ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
forall a. Maybe a
Nothing Maybe ([Pre], [Pre])
forall a. Maybe a
Nothing Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
forall a. Maybe a
Nothing DList ResultComponent
log  -- `debug` ("Init Done >>Last Action#"++show (length ads)++"F/L"++show (head ads)++show (last ads))

run TestDeal a
t Map PoolId (AssetCashflow, Maybe [AssetCashflow])
empty Maybe [ActionOnDate]
_ Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log = (TestDeal a, DList ResultComponent,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. b -> Either a b
Right (TestDeal a
t, DList ResultComponent
log ,Map PoolId (AssetCashflow, Maybe [AssetCashflow])
empty) -- `debug` ("End with pool CF is []")



-- reserved for future used
data ExpectReturn = DealLogs
                  | AssetLevelFlow
                  deriving (Int -> ExpectReturn -> [Char] -> [Char]
[ExpectReturn] -> [Char] -> [Char]
ExpectReturn -> [Char]
(Int -> ExpectReturn -> [Char] -> [Char])
-> (ExpectReturn -> [Char])
-> ([ExpectReturn] -> [Char] -> [Char])
-> Show ExpectReturn
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ExpectReturn -> [Char] -> [Char]
showsPrec :: Int -> ExpectReturn -> [Char] -> [Char]
$cshow :: ExpectReturn -> [Char]
show :: ExpectReturn -> [Char]
$cshowList :: [ExpectReturn] -> [Char] -> [Char]
showList :: [ExpectReturn] -> [Char] -> [Char]
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 [Char] (Rate, [Txn])
priceBondIrr AP.BuyBond {} [] = [Char] -> Either [Char] (Rate, [Txn])
forall a b. a -> Either a b
Left [Char]
"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 [Char] Rate
Analytics.calcIRR [Date]
ds [Balance]
vs
        (Rate, [Txn]) -> Either [Char] (Rate, [Txn])
forall a. a -> Either [Char] 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 [Char] 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 [Char] (Rate, [Txn])
forall a. a -> Either [Char] 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 [Char] 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 [Char] (Rate, [Txn])
forall a. a -> Either [Char] 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' = [Char] -> Either [Char] (Rate, [Txn])
forall a b. a -> Either a b
Left [Char]
"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 [Char] 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 [Char] (Rate, [Txn])
forall a. a -> Either [Char] 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 [Char] (Map [Char] PriceResult)
priceBonds TestDeal a
t (AP.DiscountCurve Date
d Ts
dc) = Map [Char] PriceResult -> Either [Char] (Map [Char] PriceResult)
forall a b. b -> Either a b
Right (Map [Char] PriceResult -> Either [Char] (Map [Char] PriceResult))
-> Map [Char] PriceResult -> Either [Char] (Map [Char] PriceResult)
forall a b. (a -> b) -> a -> b
$ (Bond -> PriceResult) -> Map [Char] Bond -> Map [Char] 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 [Char] Bond
forall a. TestDeal a -> Map [Char] Bond
viewBondsInMap TestDeal a
t)
-- Run Z-Spread
priceBonds t :: TestDeal a
t@TestDeal {bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds = Map [Char] Bond
bndMap} (AP.RunZSpread Ts
curve Map [Char] (Date, Rate)
bondPrices) 
  = Map [Char] (Either [Char] PriceResult)
-> Either [Char] (Map [Char] PriceResult)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map [Char] (f a) -> f (Map [Char] a)
sequenceA (Map [Char] (Either [Char] PriceResult)
 -> Either [Char] (Map [Char] PriceResult))
-> Map [Char] (Either [Char] PriceResult)
-> Either [Char] (Map [Char] PriceResult)
forall a b. (a -> b) -> a -> b
$ 
      ([Char] -> (Date, Rate) -> Either [Char] PriceResult)
-> Map [Char] (Date, Rate)
-> Map [Char] (Either [Char] PriceResult)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
        (\[Char]
bn (Date
pd,Rate
price)-> IRate -> PriceResult
ZSpread (IRate -> PriceResult)
-> Either [Char] IRate -> Either [Char] PriceResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rate, Date) -> Bond -> Ts -> Either [Char] IRate
L.calcZspread (Rate
price,Date
pd) (Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bn) Ts
curve)
        Map [Char] (Date, Rate)
bondPrices
-- Calc Irr of bonds 
priceBonds t :: TestDeal a
t@TestDeal {bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds = Map [Char] Bond
bndMap} (AP.IrrInput Map [Char] 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 [Char] (Maybe Bond, IrrType)
bndMap' = ([Char] -> IrrType -> (Maybe Bond, IrrType))
-> Map [Char] IrrType -> Map [Char] (Maybe Bond, IrrType)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\[Char]
k IrrType
v -> (TestDeal a -> Bool -> [Char] -> Maybe Bond
forall a. Asset a => TestDeal a -> Bool -> [Char] -> Maybe Bond
getBondByName TestDeal a
t Bool
True [Char]
k, IrrType
v)) Map [Char] IrrType
bMapInput
      -- (Rate, [(date, cash)])
      bndMap'' :: Map [Char] (Either [Char] PriceResult)
bndMap'' = ([Char] -> (Maybe Bond, IrrType) -> Either [Char] PriceResult)
-> Map [Char] (Maybe Bond, IrrType)
-> Map [Char] (Either [Char] PriceResult)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\[Char]
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 [Char] (Rate, [Txn])
priceBondIrr IrrType
v [Txn]
_irrTxns
                                    PriceResult -> Either [Char] PriceResult
forall a. a -> Either [Char] 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 [Char] (Maybe Bond, IrrType)
bndMap'
    in 
      Map [Char] (Either [Char] PriceResult)
-> Either [Char] (Map [Char] PriceResult)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map [Char] (f a) -> f (Map [Char] a)
sequenceA Map [Char] (Either [Char] PriceResult)
bndMap''


-- ^ split call option assumption , 
-- lefts are for waterfall payment days
-- rights are for date-based calls
splitCallOpts :: AP.CallOpt -> ([Pre],[Pre])
splitCallOpts :: CallOpt -> ([Pre], [Pre])
splitCallOpts (AP.CallPredicate [Pre]
ps) = ([Pre]
ps,[])
splitCallOpts (AP.LegacyOpts [CallOption]
copts) = 
    let 
      cFn :: CallOption -> Pre
cFn (C.PoolBalance Balance
bal) = Cmp -> DealStats -> Balance -> Pre
If Cmp
L (Maybe [PoolId] -> DealStats
CurrentPoolBalance Maybe [PoolId]
forall a. Maybe a
Nothing) Balance
bal
      cFn (C.BondBalance Balance
bal) = Cmp -> DealStats -> Balance -> Pre
If Cmp
L DealStats
CurrentBondBalance Balance
bal
      cFn (C.PoolFactor Rate
r) = Cmp -> DealStats -> IRate -> Pre
IfRate Cmp
L (Maybe [PoolId] -> DealStats
PoolFactor Maybe [PoolId]
forall a. Maybe a
Nothing) (Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational Rate
r)
      cFn (C.BondFactor Rate
r) = Cmp -> DealStats -> IRate -> Pre
IfRate Cmp
L DealStats
BondFactor (Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational Rate
r)
      cFn (C.OnDate Date
d) = Cmp -> Date -> Pre
IfDate Cmp
E Date
d
      cFn (C.AfterDate Date
d) = Cmp -> Date -> Pre
IfDate Cmp
G Date
d
      cFn (C.And [CallOption]
_opts) = [Pre] -> Pre
Types.All [ CallOption -> Pre
cFn CallOption
o | CallOption
o <- [CallOption]
_opts  ]
      cFn (C.Or [CallOption]
_opts) = [Pre] -> Pre
Types.Any [ CallOption -> Pre
cFn CallOption
o | CallOption
o <- [CallOption]
_opts  ]
      cFn (C.Pre Pre
p) = Pre
p
    in 
      ([ CallOption -> Pre
cFn CallOption
copt | CallOption
copt <- [CallOption]
copts ],[])
-- legacyCallOptConvert (AP.CallOptions opts) = concat [ legacyCallOptConvert o | o <- opts ]
splitCallOpts (AP.CallOnDates RateReset
dp [Pre]
ps) = ([],[Pre]
ps)


-- <Legacy Test>, <Test on dates>
readCallOptions :: [AP.CallOpt] -> ([Pre],[Pre])
readCallOptions :: [CallOpt] -> ([Pre], [Pre])
readCallOptions [] = ([],[])
readCallOptions [CallOpt]
opts = 
  let 
    result :: [([Pre], [Pre])]
result = CallOpt -> ([Pre], [Pre])
splitCallOpts (CallOpt -> ([Pre], [Pre])) -> [CallOpt] -> [([Pre], [Pre])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CallOpt]
opts
  in 
    ([[Pre]] -> [Pre]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Pre], [Pre]) -> [Pre]
forall a b. (a, b) -> a
fst (([Pre], [Pre]) -> [Pre]) -> [([Pre], [Pre])] -> [[Pre]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Pre], [Pre])]
result), [[Pre]] -> [Pre]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Pre], [Pre]) -> [Pre]
forall a b. (a, b) -> b
snd (([Pre], [Pre]) -> [Pre]) -> [([Pre], [Pre])] -> [[Pre]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Pre], [Pre])]
result))


runDeal :: Ast.Asset a => TestDeal a -> S.Set ExpectReturn -> Maybe AP.ApplyAssumptionType-> AP.NonPerfAssumption
        -> Either String (TestDeal a
                         , Map.Map PoolId CF.CashFlowFrame
			 , [ResultComponent]
                         , Map.Map String PriceResult
                         , Map.Map PoolId CF.PoolCashflow)
runDeal :: forall a.
Asset a =>
TestDeal a
-> Set ExpectReturn
-> Maybe ApplyAssumptionType
-> NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
      Map [Char] PriceResult,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 = [Char]
-> Either
     [Char]
     (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
      Map [Char] PriceResult,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. a -> Either a b
Left ([Char]
 -> Either
      [Char]
      (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
       Map [Char] PriceResult,
       Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> [Char]
-> Either
     [Char]
     (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
      Map [Char] PriceResult,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ [Char] -> FeeNames -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
";" (FeeNames -> [Char]) -> FeeNames -> [Char]
forall a b. (a -> b) -> a -> b
$ ResultComponent -> [Char]
forall a. Show a => a -> [Char]
show (ResultComponent -> [Char]) -> [ResultComponent] -> FeeNames
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultComponent]
valLogs 
  | Bool
otherwise 
    = do 
        (TestDeal a
newT, [ActionOnDate]
ads, Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pcf, Map PoolId (AssetCashflow, Maybe [AssetCashflow])
unStressPcf) <- Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, [ActionOnDate],
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]),
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, [ActionOnDate],
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]),
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 (AssetCashflow, Maybe [AssetCashflow])
osPoolFlow) <- TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     [Char]
     (TestDeal a, DList ResultComponent,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
run (TestDeal a -> TestDeal a
forall a. Asset a => TestDeal a -> TestDeal a
removePoolCf TestDeal a
newT) 
                                              Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pcf
                                              ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) 
                                              Maybe [RateAssumption]
mInterest
                                              ([CallOpt] -> ([Pre], [Pre])
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 [Char] (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 AssetCashflow
poolFlowUsedNoEmpty = (AssetCashflow -> AssetCashflow)
-> Map PoolId AssetCashflow -> Map PoolId AssetCashflow
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
	                            ((([TsRow] -> Identity [TsRow])
 -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> [TsRow]) -> AssetCashflow -> AssetCashflow
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn [TsRow] -> [TsRow]
CF.dropTailEmptyTxns) 
	                            (TestDeal a -> Maybe [PoolId] -> Map PoolId AssetCashflow
forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId AssetCashflow
getAllCollectedFrame TestDeal a
finalDeal Maybe [PoolId]
forall a. Maybe a
Nothing)
        let poolFlowUnUsed :: Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowUnUsed = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
osPoolFlow Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> (Map PoolId (AssetCashflow, Maybe [AssetCashflow])
    -> Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a b. a -> (a -> b) -> b
& ((AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
Setter
  (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
  (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((AssetCashflow, Maybe [AssetCashflow])
  -> Identity (AssetCashflow, Maybe [AssetCashflow]))
 -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> (([TsRow] -> Identity [TsRow])
    -> (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> ([TsRow] -> Identity [TsRow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetCashflow -> Identity AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  AssetCashflow
  AssetCashflow
_1 ((AssetCashflow -> Identity AssetCashflow)
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> (([TsRow] -> Identity [TsRow])
    -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> Identity [TsRow])
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn (([TsRow] -> Identity [TsRow])
 -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> ([TsRow] -> [TsRow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [TsRow] -> [TsRow]
CF.dropTailEmptyTxns
		                        Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> (Map PoolId (AssetCashflow, Maybe [AssetCashflow])
    -> Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a b. a -> (a -> b) -> b
& ((AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
Setter
  (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
  (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((AssetCashflow, Maybe [AssetCashflow])
  -> Identity (AssetCashflow, Maybe [AssetCashflow]))
 -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> (([TsRow] -> Identity [TsRow])
    -> (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> ([TsRow] -> Identity [TsRow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  (Maybe [AssetCashflow])
  (Maybe [AssetCashflow])
_2 ((Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> (([TsRow] -> Identity [TsRow])
    -> Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
-> ([TsRow] -> Identity [TsRow])
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AssetCashflow] -> Identity [AssetCashflow])
-> Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow])
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (([AssetCashflow] -> Identity [AssetCashflow])
 -> Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
-> (([TsRow] -> Identity [TsRow])
    -> [AssetCashflow] -> Identity [AssetCashflow])
-> ([TsRow] -> Identity [TsRow])
-> Maybe [AssetCashflow]
-> Identity (Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetCashflow -> Identity AssetCashflow)
-> [AssetCashflow] -> Identity [AssetCashflow]
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  [AssetCashflow] [AssetCashflow] AssetCashflow AssetCashflow
each ((AssetCashflow -> Identity AssetCashflow)
 -> [AssetCashflow] -> Identity [AssetCashflow])
-> (([TsRow] -> Identity [TsRow])
    -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> Identity [TsRow])
-> [AssetCashflow]
-> Identity [AssetCashflow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn (([TsRow] -> Identity [TsRow])
 -> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> ([TsRow] -> [TsRow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [TsRow] -> [TsRow]
CF.dropTailEmptyTxns
        Map [Char] PriceResult
bndPricing <- case Maybe BondPricingInput
mPricing of 
                        (Just BondPricingInput
p) -> TestDeal a
-> BondPricingInput -> Either [Char] (Map [Char] PriceResult)
forall a.
Asset a =>
TestDeal a
-> BondPricingInput -> Either [Char] (Map [Char] PriceResult)
priceBonds TestDeal a
finalDeal BondPricingInput
p 
                        Maybe BondPricingInput
Nothing -> Map [Char] PriceResult -> Either [Char] (Map [Char] PriceResult)
forall a b. b -> Either a b
Right Map [Char] PriceResult
forall k a. Map k a
Map.empty
        (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
 Map [Char] PriceResult,
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
      Map [Char] PriceResult,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
finalDeal
                 , Map PoolId AssetCashflow
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 (AssetCashflow, Maybe [AssetCashflow])
-> DList ResultComponent
forall {s} {k}.
(Field1 s s AssetCashflow AssetCashflow, Show k) =>
Map k s -> DList ResultComponent
unCollectedPoolFlowWarning Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolFlowUnUsed))
		 , Map [Char] PriceResult
bndPricing
	         , Map PoolId (AssetCashflow, Maybe [AssetCashflow])
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 [Char] (RevolvingPool, ApplyAssumptionType))
mRevolvingCtx = case Maybe RevolvingAssumption
mRevolving of
                        Maybe RevolvingAssumption
Nothing -> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
forall a. Maybe a
Nothing
                        Just (AP.AvailableAssets RevolvingPool
rp ApplyAssumptionType
rperf) -> Map [Char] (RevolvingPool, ApplyAssumptionType)
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
forall a. a -> Maybe a
Just ([([Char], (RevolvingPool, ApplyAssumptionType))]
-> Map [Char] (RevolvingPool, ApplyAssumptionType)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [([Char]
"Consol", (RevolvingPool
rp, ApplyAssumptionType
rperf))])
                        Just (AP.AvailableAssetsBy Map [Char] (RevolvingPool, ApplyAssumptionType)
rMap) -> Map [Char] (RevolvingPool, ApplyAssumptionType)
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
forall a. a -> Maybe a
Just Map [Char] (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 (AssetCashflow -> Int
CF.sizeCashFlowFrame (AssetCashflow -> Int) -> (s -> AssetCashflow) -> s -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting AssetCashflow s AssetCashflow -> s -> AssetCashflow
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AssetCashflow s AssetCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens s s AssetCashflow AssetCashflow
_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
$ [Char] -> ResultComponent
WarningMsg ([Char] -> ResultComponent) -> [Char] -> ResultComponent
forall a b. (a -> b) -> a -> b
$ [Char]
"Oustanding pool cashflow hasn't been collected yet"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Map k Int -> [Char]
forall a. Show a => a -> [Char]
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 = [ [Char] -> Balance -> Balance -> ResultComponent
BondOutstanding (Bond -> [Char]
L.bndName Bond
_b) (Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getCurBalance Bond
_b) (TestDeal a -> [Char] -> Balance
forall a. SPV a => a -> [Char] -> Balance
getBondBegBal TestDeal a
t (Bond -> [Char]
L.bndName Bond
_b)) | Bond
_b <- [Bond]
bs ] -- `debug` ("B"++ show bs)
    os_bn_i :: [ResultComponent]
os_bn_i = [ [Char] -> Balance -> Balance -> ResultComponent
BondOutstandingInt (Bond -> [Char]
L.bndName Bond
_b) (Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt Bond
_b) (TestDeal a -> [Char] -> Balance
forall a. SPV a => a -> [Char] -> Balance
getBondBegBal TestDeal a
t (Bond -> [Char]
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 [Char] Bond
bonds = Map [Char] Bond
bndMap ,pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
poolType } 
  = let 
      consolePoolFlowFn :: AssetCashflow -> AssetCashflow
consolePoolFlowFn = (([TsRow] -> Identity [TsRow])
 -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> [TsRow]) -> AssetCashflow -> AssetCashflow
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn [TsRow] -> [TsRow]
CF.dropTailEmptyTxns
      rmAssetLevelFn :: [AssetCashflow] -> [AssetCashflow]
rmAssetLevelFn [AssetCashflow]
xs 
        | ExpectReturn -> Set ExpectReturn -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ExpectReturn
AssetLevelFlow Set ExpectReturn
er = [AssetCashflow]
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) consolePoolFlowFn
			  & over (_MultiPool . mapped . P.poolFutureCf . _Just . _2 . _Just) rmAssetLevelFn 
	}


appendCollectedCF :: Ast.Asset a => Date -> TestDeal a -> Map.Map PoolId CF.PoolCashflow -> TestDeal a
-- ^ append cashflow frame (consolidate by a date) into deals collected pool
appendCollectedCF :: forall a.
Asset a =>
Date
-> TestDeal a
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> TestDeal a
appendCollectedCF Date
d t :: TestDeal a
t@TestDeal { pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pt } Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolInflowMap
  = let
      newPt :: PoolType a
newPt = case PoolType a
pt of
                MultiPool Map PoolId (Pool a)
poolM -> 
                  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
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Map PoolId (Pool a)
 -> Map PoolId (Pool a))
-> Map PoolId (Pool a)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (Pool a)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
                      (\PoolId
k (CF.CashFlowFrame BeginStatus
st [TsRow]
txnCollected, Maybe [AssetCashflow]
mAssetFlow) Map PoolId (Pool a)
acc ->
                        let 
                          currentStats :: CumulativeStat
currentStats = case Getting [TsRow] (Pool a) [TsRow] -> Pool a -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Const [TsRow] (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> Pool a -> Const [TsRow] (Pool a)
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureCf ((Maybe (AssetCashflow, Maybe [AssetCashflow])
  -> Const [TsRow] (Maybe (AssetCashflow, Maybe [AssetCashflow])))
 -> Pool a -> Const [TsRow] (Pool a))
-> (([TsRow] -> Const [TsRow] [TsRow])
    -> Maybe (AssetCashflow, Maybe [AssetCashflow])
    -> Const [TsRow] (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> Getting [TsRow] (Pool a) [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetCashflow, Maybe [AssetCashflow])
 -> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((AssetCashflow, Maybe [AssetCashflow])
  -> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow]))
 -> Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Const [TsRow] (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> (([TsRow] -> Const [TsRow] [TsRow])
    -> (AssetCashflow, Maybe [AssetCashflow])
    -> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow]))
-> ([TsRow] -> Const [TsRow] [TsRow])
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetCashflow -> Const [TsRow] AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  AssetCashflow
  AssetCashflow
_1 ((AssetCashflow -> Const [TsRow] AssetCashflow)
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow]))
-> Getting [TsRow] AssetCashflow [TsRow]
-> ([TsRow] -> Const [TsRow] [TsRow])
-> (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [TsRow] AssetCashflow [TsRow]
Lens' AssetCashflow [TsRow]
CF.cashflowTxn) (Map PoolId (Pool a)
acc Map PoolId (Pool a) -> PoolId -> Pool a
forall k a. Ord k => Map k a -> k -> a
Map.! PoolId
k) of
                                          [] -> Pool a -> CumulativeStat
forall a. Pool a -> CumulativeStat
P.poolBegStats (Map PoolId (Pool a)
acc Map PoolId (Pool a) -> PoolId -> Pool a
forall k a. Ord k => Map k a -> k -> a
Map.! PoolId
k)
                                          [TsRow]
txns -> CumulativeStat -> Maybe CumulativeStat -> CumulativeStat
forall a. a -> Maybe a -> a
fromMaybe (Balance
0,Balance
0,Balance
0,Balance
0,Balance
0,Balance
0) (Maybe CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> CumulativeStat
forall a b. (a -> b) -> a -> b
$ Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
-> TsRow -> Maybe CumulativeStat
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
Lens' TsRow (Maybe CumulativeStat)
CF.txnCumulativeStats ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
txns)
                          balInCollected :: Balance
balInCollected = case [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
txnCollected of 
                                             Int
0 -> Balance
0 
                                             Int
_ ->  Getting Balance TsRow Balance -> TsRow -> Balance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Balance TsRow Balance
Lens' TsRow Balance
CF.tsRowBalance (TsRow -> Balance) -> TsRow -> Balance
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
txnCollected
                          txnToAppend :: [TsRow]
txnToAppend = CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
CF.patchCumulative CumulativeStat
currentStats [] [TsRow]
txnCollected
			  -- insert aggregated pool flow
                          accUpdated :: Map PoolId (Pool a)
accUpdated =  (Pool a -> Pool a)
-> PoolId -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
			                  (\Pool a
_v -> case (Pool a -> Maybe (AssetCashflow, Maybe [AssetCashflow])
forall a. Pool a -> Maybe (AssetCashflow, Maybe [AssetCashflow])
P.futureCf Pool a
_v) of
					            Maybe (AssetCashflow, Maybe [AssetCashflow])
Nothing -> ASetter
  (Pool a)
  (Pool a)
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow]) -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Pool a)
  (Pool a)
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureCf ((AssetCashflow, Maybe [AssetCashflow])
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
forall a. a -> Maybe a
Just (BeginStatus -> [TsRow] -> AssetCashflow
CF.CashFlowFrame BeginStatus
st [TsRow]
txnCollected , Maybe [AssetCashflow]
forall a. Maybe a
Nothing)) Pool a
_v
						    Just (AssetCashflow, Maybe [AssetCashflow])
_ -> ASetter (Pool a) (Pool a) [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ASetter
  (Pool a)
  (Pool a)
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureCf ASetter
  (Pool a)
  (Pool a)
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
-> (([TsRow] -> Identity [TsRow])
    -> Maybe (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> ASetter (Pool a) (Pool a) [TsRow] [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((AssetCashflow, Maybe [AssetCashflow])
  -> Identity (AssetCashflow, Maybe [AssetCashflow]))
 -> Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> (([TsRow] -> Identity [TsRow])
    -> (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> ([TsRow] -> Identity [TsRow])
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetCashflow -> Identity AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  AssetCashflow
  AssetCashflow
_1 ((AssetCashflow -> Identity AssetCashflow)
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> (([TsRow] -> Identity [TsRow])
    -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> Identity [TsRow])
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn) ([TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
txnToAppend) Pool a
_v
				          )
					  PoolId
k
					  Map PoolId (Pool a)
acc 
			  -- insert breakdown asset flow
			  accUpdated' :: Map PoolId (Pool a)
accUpdated' = case Maybe [AssetCashflow]
mAssetFlow of 
					  Maybe [AssetCashflow]
Nothing -> Map PoolId (Pool a)
accUpdated
					  Just [AssetCashflow]
collectedAssetFlow -> 
					    let 
					      appendFn :: Maybe [AssetCashflow] -> Maybe [AssetCashflow]
appendFn Maybe [AssetCashflow]
Nothing = [AssetCashflow] -> Maybe [AssetCashflow]
forall a. a -> Maybe a
Just [AssetCashflow]
collectedAssetFlow   
					      appendFn (Just [AssetCashflow]
cfs) 
					        | [AssetCashflow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AssetCashflow]
cfs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [AssetCashflow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AssetCashflow]
collectedAssetFlow 
	                                            = [AssetCashflow] -> Maybe [AssetCashflow]
forall a. a -> Maybe a
Just ([AssetCashflow] -> Maybe [AssetCashflow])
-> [AssetCashflow] -> Maybe [AssetCashflow]
forall a b. (a -> b) -> a -> b
$ [ AssetCashflow
origin AssetCashflow -> (AssetCashflow -> AssetCashflow) -> AssetCashflow
forall a b. a -> (a -> b) -> b
& (([TsRow] -> Identity [TsRow])
 -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> [TsRow]) -> AssetCashflow -> AssetCashflow
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn ([TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ (Getting [TsRow] AssetCashflow [TsRow] -> AssetCashflow -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] AssetCashflow [TsRow]
Lens' AssetCashflow [TsRow]
CF.cashflowTxn AssetCashflow
new)) | (AssetCashflow
origin,AssetCashflow
new) <- [AssetCashflow]
-> [AssetCashflow] -> [(AssetCashflow, AssetCashflow)]
forall a b. [a] -> [b] -> [(a, b)]
zip [AssetCashflow]
cfs  [AssetCashflow]
collectedAssetFlow ] 
						| [AssetCashflow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AssetCashflow]
collectedAssetFlow  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [AssetCashflow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AssetCashflow]
cfs 
                                                    = let 
                                                        dummyCashFrames :: [AssetCashflow]
dummyCashFrames = Int -> AssetCashflow -> [AssetCashflow]
forall a. Int -> a -> [a]
replicate ([AssetCashflow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AssetCashflow]
collectedAssetFlow Int -> Int -> Int
forall a. Num a => a -> a -> a
- [AssetCashflow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AssetCashflow]
cfs) AssetCashflow
CF.emptyCashflow 
						      in 
						        [AssetCashflow] -> Maybe [AssetCashflow]
forall a. a -> Maybe a
Just ([AssetCashflow] -> Maybe [AssetCashflow])
-> [AssetCashflow] -> Maybe [AssetCashflow]
forall a b. (a -> b) -> a -> b
$ [ AssetCashflow
origin AssetCashflow -> (AssetCashflow -> AssetCashflow) -> AssetCashflow
forall a b. a -> (a -> b) -> b
& (([TsRow] -> Identity [TsRow])
 -> AssetCashflow -> Identity AssetCashflow)
-> ([TsRow] -> [TsRow]) -> AssetCashflow -> AssetCashflow
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([TsRow] -> Identity [TsRow])
-> AssetCashflow -> Identity AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn) ([TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ (Getting [TsRow] AssetCashflow [TsRow] -> AssetCashflow -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] AssetCashflow [TsRow]
Lens' AssetCashflow [TsRow]
CF.cashflowTxn AssetCashflow
new)) | (AssetCashflow
origin,AssetCashflow
new) <- [AssetCashflow]
-> [AssetCashflow] -> [(AssetCashflow, AssetCashflow)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([AssetCashflow]
cfs[AssetCashflow] -> [AssetCashflow] -> [AssetCashflow]
forall a. [a] -> [a] -> [a]
++[AssetCashflow]
dummyCashFrames) [AssetCashflow]
collectedAssetFlow ]
						| Bool
otherwise = [Char] -> Maybe [AssetCashflow]
forall a. HasCallStack => [Char] -> a
error [Char]
"incomping cashflow number shall greater than existing cashflow number"
					    in 
					      Map PoolId (Pool a)
accUpdated Map PoolId (Pool a)
-> (Map PoolId (Pool a) -> Map PoolId (Pool a))
-> Map PoolId (Pool a)
forall a b. a -> (a -> b) -> b
& Index (Map PoolId (Pool a))
-> Traversal' (Map PoolId (Pool a)) (IxValue (Map PoolId (Pool a)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map PoolId (Pool a))
PoolId
k ((Pool a -> Identity (Pool a))
 -> Map PoolId (Pool a) -> Identity (Map PoolId (Pool a)))
-> (Pool a -> Pool a) -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (ASetter
  (Pool a) (Pool a) (Maybe [AssetCashflow]) (Maybe [AssetCashflow])
-> (Maybe [AssetCashflow] -> Maybe [AssetCashflow])
-> Pool a
-> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ASetter
  (Pool a)
  (Pool a)
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureCf ASetter
  (Pool a)
  (Pool a)
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
-> ((Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
    -> Maybe (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> ASetter
     (Pool a) (Pool a) (Maybe [AssetCashflow]) (Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((AssetCashflow, Maybe [AssetCashflow])
  -> Identity (AssetCashflow, Maybe [AssetCashflow]))
 -> Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> ((Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
    -> (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> (Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [AssetCashflow] -> Identity (Maybe [AssetCashflow]))
-> (AssetCashflow, Maybe [AssetCashflow])
-> Identity (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  (Maybe [AssetCashflow])
  (Maybe [AssetCashflow])
_2) Maybe [AssetCashflow] -> Maybe [AssetCashflow]
appendFn)
                        in 
                          (Pool a -> Pool a)
-> PoolId -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust 
                            (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
balInCollected))
                            PoolId
k Map PoolId (Pool a)
accUpdated') 
                      Map PoolId (Pool a)
poolM 
                      Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolInflowMap
                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) -> PoolType a)
-> Map PoolId (UnderlyingDeal a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ 
                    (PoolId
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Map PoolId (UnderlyingDeal a)
 -> Map PoolId (UnderlyingDeal a))
-> Map PoolId (UnderlyingDeal a)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (UnderlyingDeal a)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
                      (\PoolId
k (CF.CashFlowFrame BeginStatus
_ [TsRow]
newTxns, Maybe [AssetCashflow]
_) Map PoolId (UnderlyingDeal a)
acc->
                        (UnderlyingDeal a -> UnderlyingDeal a)
-> PoolId
-> Map PoolId (UnderlyingDeal a)
-> Map PoolId (UnderlyingDeal a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (ASetter (UnderlyingDeal a) (UnderlyingDeal a) [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> UnderlyingDeal a -> UnderlyingDeal a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (UnderlyingDeal a) (UnderlyingDeal a) [TsRow] [TsRow]
forall a. Asset a => Lens' (UnderlyingDeal a) [TsRow]
Lens' (UnderlyingDeal a) [TsRow]
uDealFutureTxn ([TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
newTxns)) PoolId
k Map PoolId (UnderlyingDeal a)
acc)
                      Map PoolId (UnderlyingDeal a)
uds
		      Map PoolId (AssetCashflow, Maybe [AssetCashflow])
poolInflowMap
    in 
      TestDeal a
t {pool = newPt}  --  `debug` ("after insert bal"++ show newPt)

-- ^ 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 (AssetCashflow, Maybe [AssetCashflow]))
  (Maybe (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> 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 (AssetCashflow, Maybe [AssetCashflow])
     -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
    -> Pool a -> Identity (Pool a))
-> ASetter
     (Map PoolId (Pool a))
     (Map PoolId (Pool a))
     (Maybe (AssetCashflow, Maybe [AssetCashflow]))
     (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> Pool a -> Identity (Pool a)
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureCf) Maybe (AssetCashflow, Maybe [AssetCashflow])
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}


-- | run a pool of assets ,use asOfDate of Pool to cutoff cashflow yields from assets with assumptions supplied
runPool :: Ast.Asset a => P.Pool a -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] 
        -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)]
-- schedule cashflow just ignores the interest rate assumption
runPool :: forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
runPool (P.Pool [] (Just (AssetCashflow
cf,Maybe [AssetCashflow]
_)) Maybe (AssetCashflow, Maybe [AssetCashflow])
_ Date
asof Maybe (Map CutoffFields Balance)
_ Maybe RateReset
_ ) Maybe ApplyAssumptionType
Nothing Maybe [RateAssumption]
_ = [(AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a b. b -> Either a b
Right [(AssetCashflow
cf, Map CutoffFields Balance
forall k a. Map k a
Map.empty)]
-- schedule cashflow with stress assumption
runPool (P.Pool []  (Just (CF.CashFlowFrame BeginStatus
_ [TsRow]
txn,Maybe [AssetCashflow]
_)) Maybe (AssetCashflow, Maybe [AssetCashflow])
_ Date
asof Maybe (Map CutoffFields Balance)
_ (Just RateReset
dp)) (Just (AP.PoolLevel AssetPerf
assumps)) Maybe [RateAssumption]
mRates 
  = [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [ Mortgage
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
Ast.projCashflow (Date -> [TsRow] -> RateReset -> Mortgage
ACM.ScheduleMortgageFlow Date
asof [TsRow]
txn RateReset
dp) Date
asof AssetPerf
assumps Maybe [RateAssumption]
mRates ] -- `debug` ("PROJ in schedule flow")

-- project contractual cashflow if nothing found in pool perf assumption
-- use interest rate assumption
runPool (P.Pool [a]
as Maybe (AssetCashflow, Maybe [AssetCashflow])
_ Maybe (AssetCashflow, Maybe [AssetCashflow])
_ Date
asof Maybe (Map CutoffFields Balance)
_ Maybe RateReset
_) Maybe ApplyAssumptionType
Nothing Maybe [RateAssumption]
mRates 
  = do 
      [AssetCashflow]
cf <- [Either [Char] AssetCashflow] -> Either [Char] [AssetCashflow]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] AssetCashflow] -> Either [Char] [AssetCashflow])
-> [Either [Char] AssetCashflow] -> Either [Char] [AssetCashflow]
forall a b. (a -> b) -> a -> b
$ Strategy (Either [Char] AssetCashflow)
-> (a -> Either [Char] AssetCashflow)
-> [a]
-> [Either [Char] AssetCashflow]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] AssetCashflow)
forall a. NFData a => Strategy a
rdeepseq  
                              (\a
x -> a -> Date -> Maybe [RateAssumption] -> Either [Char] AssetCashflow
forall a.
Asset a =>
a -> Date -> Maybe [RateAssumption] -> Either [Char] AssetCashflow
Ast.calcCashflow a
x Date
asof Maybe [RateAssumption]
mRates) 
                              [a]
as 
      [(AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (AssetCashflow
x, Map CutoffFields Balance
forall k a. Map k a
Map.empty) | AssetCashflow
x <- [AssetCashflow]
cf ]
-- asset cashflow with credit stress
---- By pool level
runPool (P.Pool [a]
as Maybe (AssetCashflow, Maybe [AssetCashflow])
_ Maybe (AssetCashflow, Maybe [AssetCashflow])
Nothing Date
asof Maybe (Map CutoffFields Balance)
_ Maybe RateReset
_) (Just (AP.PoolLevel AssetPerf
assumps)) Maybe [RateAssumption]
mRates 
  = [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] (AssetCashflow, Map CutoffFields Balance)]
 -> Either [Char] [(AssetCashflow, Map CutoffFields Balance)])
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a b. (a -> b) -> a -> b
$ Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> (a -> Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> [a]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
Ast.projCashflow a
x Date
asof AssetPerf
assumps Maybe [RateAssumption]
mRates) [a]
as  
---- By index
runPool (P.Pool [a]
as Maybe (AssetCashflow, Maybe [AssetCashflow])
_ Maybe (AssetCashflow, Maybe [AssetCashflow])
Nothing  Date
asof Maybe (Map CutoffFields Balance)
_ Maybe RateReset
_) (Just (AP.ByIndex [StratPerfByIdx]
idxAssumps)) Maybe [RateAssumption]
mRates =
  let
    numAssets :: Int
numAssets = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as
  in
    do 
      [AssetPerf]
_assumps <- (Int -> Either [Char] AssetPerf)
-> [Int] -> Either [Char] [AssetPerf]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([StratPerfByIdx] -> Int -> Either [Char] AssetPerf
AP.lookupAssumptionByIdx [StratPerfByIdx]
idxAssumps) [Int
0..(Int -> Int
forall a. Enum a => a -> a
pred Int
numAssets)] -- `debug` ("Num assets"++ show numAssets)
      [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] (AssetCashflow, Map CutoffFields Balance)]
 -> Either [Char] [(AssetCashflow, Map CutoffFields Balance)])
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a b. (a -> b) -> a -> b
$ Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> ((a, AssetPerf)
    -> Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> [(a, AssetPerf)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
forall a. NFData a => Strategy a
rdeepseq (\(a
x, AssetPerf
a) -> a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
Ast.projCashflow a
x Date
asof AssetPerf
a Maybe [RateAssumption]
mRates) ([a] -> [AssetPerf] -> [(a, AssetPerf)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [AssetPerf]
_assumps)

---- By Obligor
runPool (P.Pool [a]
as Maybe (AssetCashflow, Maybe [AssetCashflow])
_ Maybe (AssetCashflow, Maybe [AssetCashflow])
Nothing Date
asof Maybe (Map CutoffFields Balance)
_ Maybe RateReset
_) (Just (AP.ByObligor [ObligorStrategy]
obligorRules)) Maybe [RateAssumption]
mRates =
  let
    -- result cf,rules,assets
    -- matchAssets:: Ast.Asset c => [Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> [AP.ObligorStrategy] 
    --               -> [c] -> Either String [(CF.CashFlowFrame, Map.Map CutoffFields Balance)] 
    matchAssets :: [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [ObligorStrategy]
-> [a]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
matchAssets []   [ObligorStrategy]
_ [] = [(AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a b. b -> Either a b
Right [(BeginStatus -> [TsRow] -> AssetCashflow
CF.CashFlowFrame (Balance
0,Date
epocDate,Maybe Balance
forall a. Maybe a
Nothing) [], Map CutoffFields Balance
forall k a. Map k a
Map.empty)] 
    matchAssets [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs [] [] = [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs
    -- matchAssets cfs [] astList = sequenceA $ cfs ++ ((\x -> (\y -> (y, Map.empty)) <$> (Ast.calcCashflow x asof mRates)) <$> astList)
    matchAssets [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs [] [a]
astList = let
                                    poolCfs :: [Either [Char] AssetCashflow]
poolCfs = Strategy (Either [Char] AssetCashflow)
-> (a -> Either [Char] AssetCashflow)
-> [a]
-> [Either [Char] AssetCashflow]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] AssetCashflow)
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a -> Date -> Maybe [RateAssumption] -> Either [Char] AssetCashflow
forall a.
Asset a =>
a -> Date -> Maybe [RateAssumption] -> Either [Char] AssetCashflow
Ast.calcCashflow a
x Date
asof Maybe [RateAssumption]
mRates) [a]
astList
                                    poolCfs' :: [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
poolCfs' = (\Either [Char] AssetCashflow
x -> (, Map CutoffFields Balance
forall k a. Map k a
Map.empty) (AssetCashflow -> (AssetCashflow, Map CutoffFields Balance))
-> Either [Char] AssetCashflow
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] AssetCashflow
x) (Either [Char] AssetCashflow
 -> Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> [Either [Char] AssetCashflow]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either [Char] AssetCashflow]
poolCfs
                                 in 
                                    [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] (AssetCashflow, Map CutoffFields Balance)]
 -> Either [Char] [(AssetCashflow, Map CutoffFields Balance)])
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a b. (a -> b) -> a -> b
$ [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall a. [a] -> [a] -> [a]
++ [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
poolCfs'
    matchAssets [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs (ObligorStrategy
rule:[ObligorStrategy]
rules) [a]
astList = 
      case ObligorStrategy
rule of 
        AP.ObligorById FeeNames
ids AssetPerf
assetPerf 
          -> let 
               idSet :: Set [Char]
idSet = FeeNames -> Set [Char]
forall a. Ord a => [a] -> Set a
S.fromList FeeNames
ids
               ([a]
matchedAsts,[a]
unMatchedAsts) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition 
                                               (\a
x -> case a -> Maybe [Char]
forall a. Asset a => a -> Maybe [Char]
Ast.getObligorId a
x of 
                                                         Just [Char]
oid -> [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member [Char]
oid Set [Char]
idSet
                                                         Maybe [Char]
Nothing -> Bool
False) 
                                               [a]
astList
               matchedCfs :: [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
matchedCfs = Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> (a -> Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> [a]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
Ast.projCashflow a
x Date
asof AssetPerf
assetPerf Maybe [RateAssumption]
mRates) [a]
matchedAsts 
             in 
               [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [ObligorStrategy]
-> [a]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
matchAssets ([Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall a. [a] -> [a] -> [a]
++ [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
matchedCfs) [ObligorStrategy]
rules [a]
unMatchedAsts
        AP.ObligorByTag FeeNames
tags TagMatchRule
tagRule AssetPerf
assetPerf ->
          let 
            obrTags :: Set [Char]
obrTags = FeeNames -> Set [Char]
forall a. Ord a => [a] -> Set a
S.fromList FeeNames
tags

            matchRuleFn :: TagMatchRule -> Set a -> Set a -> Bool
matchRuleFn TagMatchRule
AP.TagEq Set a
s1 Set a
s2 = Set a
s1 Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
s2 
            matchRuleFn TagMatchRule
AP.TagSubset Set a
s1 Set a
s2 = Set a
s1 Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set a
s2
            matchRuleFn TagMatchRule
AP.TagSuperset Set a
s1 Set a
s2 = Set a
s2 Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set a
s1
            matchRuleFn TagMatchRule
AP.TagAny Set a
s1 Set a
s2 = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> Bool
forall a. Set a -> Bool
S.null (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set a
s1 Set a
s2
            matchRuleFn (AP.TagNot TagMatchRule
tRule) Set a
s1 Set a
s2 = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TagMatchRule -> Set a -> Set a -> Bool
matchRuleFn TagMatchRule
tRule Set a
s1 Set a
s2
            
            ([a]
matchedAsts,[a]
unMatchedAsts) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\a
x -> TagMatchRule -> Set [Char] -> Set [Char] -> Bool
forall {a}. Ord a => TagMatchRule -> Set a -> Set a -> Bool
matchRuleFn TagMatchRule
tagRule (a -> Set [Char]
forall a. Asset a => a -> Set [Char]
Ast.getObligorTags a
x) Set [Char]
obrTags) [a]
astList
            matchedCfs :: [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
matchedCfs = Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> (a -> Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> [a]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
Ast.projCashflow a
x Date
asof AssetPerf
assetPerf Maybe [RateAssumption]
mRates) [a]
matchedAsts 
          in 
            [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [ObligorStrategy]
-> [a]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
matchAssets ([Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall a. [a] -> [a] -> [a]
++ [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
matchedCfs) [ObligorStrategy]
rules [a]
unMatchedAsts
        
        AP.ObligorByField [FieldMatchRule]
fieldRules AssetPerf
assetPerf -> 
          let 
            matchRuleFn :: FieldMatchRule -> Maybe (Map [Char] (Either [Char] Double)) -> Bool
matchRuleFn (AP.FieldIn [Char]
fv FeeNames
fvals) Maybe (Map [Char] (Either [Char] Double))
Nothing = Bool
False
            matchRuleFn (AP.FieldIn [Char]
fv FeeNames
fvals) (Just Map [Char] (Either [Char] Double)
fm) = case [Char]
-> Map [Char] (Either [Char] Double)
-> Maybe (Either [Char] Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
fv Map [Char] (Either [Char] Double)
fm of
                                                    Just (Left [Char]
v) -> [Char]
v [Char] -> FeeNames -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FeeNames
fvals
                                                    Maybe (Either [Char] Double)
Nothing -> Bool
False
            matchRuleFn (AP.FieldCmp [Char]
fv Cmp
cmp Double
dv) (Just Map [Char] (Either [Char] Double)
fm) = case [Char]
-> Map [Char] (Either [Char] Double)
-> Maybe (Either [Char] Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
fv Map [Char] (Either [Char] Double)
fm of
                                                        Just (Right Double
v) -> case Cmp
cmp of 
                                                                    Cmp
G -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
dv
                                                                    Cmp
L -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
dv
                                                                    Cmp
GE -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
dv
                                                                    Cmp
LE -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
dv
                                                        Maybe (Either [Char] Double)
Nothing -> Bool
False
            matchRuleFn (AP.FieldInRange [Char]
fv RangeType
rt Double
dv1 Double
dv2) (Just Map [Char] (Either [Char] Double)
fm) = 
              case [Char]
-> Map [Char] (Either [Char] Double)
-> Maybe (Either [Char] Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
fv Map [Char] (Either [Char] Double)
fm of
                Just (Right Double
v) -> case RangeType
rt of 
                          RangeType
II -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
dv2 Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
dv1
                          RangeType
IE -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
dv2 Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
dv1
                          RangeType
EI -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
dv2 Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
dv1
                          RangeType
EE -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
dv2 Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
dv1
                          RangeType
_ -> Bool
False
                Maybe (Either [Char] Double)
Nothing -> Bool
False
            matchRuleFn (AP.FieldNot FieldMatchRule
fRule) Maybe (Map [Char] (Either [Char] Double))
fm = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FieldMatchRule -> Maybe (Map [Char] (Either [Char] Double)) -> Bool
matchRuleFn FieldMatchRule
fRule Maybe (Map [Char] (Either [Char] Double))
fm

            matchRulesFn :: t FieldMatchRule
-> Maybe (Map [Char] (Either [Char] Double)) -> Bool
matchRulesFn t FieldMatchRule
fs Maybe (Map [Char] (Either [Char] Double))
fm = (FieldMatchRule -> Bool) -> t FieldMatchRule -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FieldMatchRule -> Maybe (Map [Char] (Either [Char] Double)) -> Bool
`matchRuleFn` Maybe (Map [Char] (Either [Char] Double))
fm) t FieldMatchRule
fs

            ([a]
matchedAsts,[a]
unMatchedAsts) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([FieldMatchRule]
-> Maybe (Map [Char] (Either [Char] Double)) -> Bool
forall {t :: * -> *}.
Foldable t =>
t FieldMatchRule
-> Maybe (Map [Char] (Either [Char] Double)) -> Bool
matchRulesFn [FieldMatchRule]
fieldRules (Maybe (Map [Char] (Either [Char] Double)) -> Bool)
-> (a -> Maybe (Map [Char] (Either [Char] Double))) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (Map [Char] (Either [Char] Double))
forall a. Asset a => a -> Maybe (Map [Char] (Either [Char] Double))
Ast.getObligorFields) [a]
astList            
            matchedCfs :: [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
matchedCfs = Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> (a -> Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> [a]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
Ast.projCashflow a
x Date
asof AssetPerf
assetPerf Maybe [RateAssumption]
mRates) [a]
matchedAsts 
          in 
            [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [ObligorStrategy]
-> [a]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
matchAssets ([Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall a. [a] -> [a] -> [a]
++ [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
matchedCfs) [ObligorStrategy]
rules [a]
unMatchedAsts
        AP.ObligorByDefault AssetPerf
assetPerf ->
          [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [ObligorStrategy]
-> [a]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
matchAssets 
            ([Either [Char] (AssetCashflow, Map CutoffFields Balance)]
cfs [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall a. [a] -> [a] -> [a]
++ (Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> (a -> Either [Char] (AssetCashflow, Map CutoffFields Balance))
-> [a]
-> [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either [Char] (AssetCashflow, Map CutoffFields Balance))
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (AssetCashflow, Map CutoffFields Balance)
Ast.projCashflow a
x Date
asof AssetPerf
assetPerf Maybe [RateAssumption]
mRates) [a]
astList))
            []
            []
  in
    [Either [Char] (AssetCashflow, Map CutoffFields Balance)]
-> [ObligorStrategy]
-> [a]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
matchAssets [] [ObligorStrategy]
obligorRules [a]
as



-- safe net to catch other cases
runPool Pool a
_a Maybe ApplyAssumptionType
_b Maybe [RateAssumption]
_c = [Char] -> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a b. a -> Either a b
Left ([Char]
 -> Either [Char] [(AssetCashflow, Map CutoffFields Balance)])
-> [Char]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a b. (a -> b) -> a -> b
$ [Char]
"[Run Pool]: Failed to match" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Pool a -> [Char]
forall a. Show a => a -> [Char]
show Pool a
_a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe ApplyAssumptionType -> [Char]
forall a. Show a => a -> [Char]
show Maybe ApplyAssumptionType
_b [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe [RateAssumption] -> [Char]
forall a. Show a => a -> [Char]
show Maybe [RateAssumption]
_c


-- ^ patch issuance balance for PreClosing Deal
patchIssuanceBalance :: Ast.Asset a => DealStatus -> Map.Map PoolId Balance -> PoolType a -> PoolType a
-- patchIssuanceBalance (Warehousing _) balM pt = patchIssuanceBalance (PreClosing Amortizing) balM pt
patchIssuanceBalance :: 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 (AssetCashflow, Maybe [AssetCashflow])
-> PoolType a -> PoolType a
patchScheduleFlow Map PoolId (AssetCashflow, Maybe [AssetCashflow])
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
$ ((AssetCashflow, Maybe [AssetCashflow]) -> Pool a -> Pool a)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> 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)
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
-> (AssetCashflow, Maybe [AssetCashflow]) -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Maybe (AssetCashflow, Maybe [AssetCashflow])
 -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> Pool a -> Identity (Pool a)
forall a.
Asset a =>
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
Lens' (Pool a) (Maybe (AssetCashflow, Maybe [AssetCashflow]))
P.poolFutureScheduleCf ((Maybe (AssetCashflow, Maybe [AssetCashflow])
  -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
 -> Pool a -> Identity (Pool a))
-> (((AssetCashflow, Maybe [AssetCashflow])
     -> Identity (AssetCashflow, Maybe [AssetCashflow]))
    -> Maybe (AssetCashflow, Maybe [AssetCashflow])
    -> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow])))
-> ASetter
     (Pool a)
     (Pool a)
     (AssetCashflow, Maybe [AssetCashflow])
     (AssetCashflow, Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetCashflow, Maybe [AssetCashflow])
 -> Identity (AssetCashflow, Maybe [AssetCashflow]))
-> Maybe (AssetCashflow, Maybe [AssetCashflow])
-> Identity (Maybe (AssetCashflow, Maybe [AssetCashflow]))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just)) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
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


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
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 [Char] [(AssetCashflow, Map CutoffFields Balance)]
calcPoolCashflow (AP.ByName Map PoolId AssetPerf
assumpMap) PoolId
pid Pool a
v = Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
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 [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
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 [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
runPool Pool a
v (ApplyAssumptionType -> Maybe ApplyAssumptionType
forall a. a -> Maybe a
Just ApplyAssumptionType
poolAssump) Maybe [RateAssumption]
rateAssump
    in
      Map PoolId (Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 [Char] (AssetCashflow, Maybe [AssetCashflow]))
 -> Either
      [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> Map
     PoolId (Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$
        (PoolId
 -> Pool a -> Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (Pool a)
-> Map
     PoolId (Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
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 
                [(AssetCashflow, Map CutoffFields Balance)]
assetCfs <- ApplyAssumptionType
-> PoolId
-> Pool a
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
calcPoolCashflow ApplyAssumptionType
poolAssumpType PoolId
k Pool a
v
                let (AssetCashflow
poolCf,Map CutoffFields Balance
_) = Maybe (Map CutoffFields Balance)
-> [(AssetCashflow, Map CutoffFields Balance)]
-> (AssetCashflow, Map CutoffFields Balance)
P.aggPool Maybe (Map CutoffFields Balance)
poolBegStats [(AssetCashflow, Map CutoffFields Balance)]
assetCfs
                (AssetCashflow, Maybe [AssetCashflow])
-> Either [Char] (AssetCashflow, Maybe [AssetCashflow])
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (AssetCashflow
poolCf, if Bool
flag then 
				   [AssetCashflow] -> Maybe [AssetCashflow]
forall a. a -> Maybe a
Just ([AssetCashflow] -> Maybe [AssetCashflow])
-> [AssetCashflow] -> Maybe [AssetCashflow]
forall a b. (a -> b) -> a -> b
$ (AssetCashflow, Map CutoffFields Balance) -> AssetCashflow
forall a b. (a, b) -> a
fst ((AssetCashflow, Map CutoffFields Balance) -> AssetCashflow)
-> [(AssetCashflow, Map CutoffFields Balance)] -> [AssetCashflow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(AssetCashflow, Map CutoffFields Balance)]
assetCfs
		                 else
		                   Maybe [AssetCashflow]
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 [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 [Char] (AssetCashflow, Maybe [AssetCashflow]))
 -> Either
      [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow])))
-> Map
     PoolId (Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a b. (a -> b) -> a -> b
$ 
      (Pool a -> Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (Pool a)
-> Map
     PoolId (Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Pool a
p -> 
		do
		  [(AssetCashflow, Map CutoffFields Balance)]
assetFlows <- Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
forall a.
Asset a =>
Pool a
-> Maybe ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [(AssetCashflow, Map CutoffFields Balance)]
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 (AssetCashflow
poolCf, Map CutoffFields Balance
poolStatMap) = Maybe (Map CutoffFields Balance)
-> [(AssetCashflow, Map CutoffFields Balance)]
-> (AssetCashflow, Map CutoffFields Balance)
P.aggPool (Pool a -> Maybe (Map CutoffFields Balance)
forall a. Pool a -> Maybe (Map CutoffFields Balance)
P.issuanceStat Pool a
p) [(AssetCashflow, Map CutoffFields Balance)]
assetFlows
		  (AssetCashflow, Maybe [AssetCashflow])
-> Either [Char] (AssetCashflow, Maybe [AssetCashflow])
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (AssetCashflow
poolCf, if Bool
flag then 
				     [AssetCashflow] -> Maybe [AssetCashflow]
forall a. a -> Maybe a
Just ([AssetCashflow] -> Maybe [AssetCashflow])
-> [AssetCashflow] -> Maybe [AssetCashflow]
forall a b. (a -> b) -> a -> b
$ (AssetCashflow, Map CutoffFields Balance) -> AssetCashflow
forall a b. (a, b) -> a
fst ((AssetCashflow, Map CutoffFields Balance) -> AssetCashflow)
-> [(AssetCashflow, Map CutoffFields Balance)] -> [AssetCashflow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(AssetCashflow, Map CutoffFields Balance)]
assetFlows
	    		           else
		                     Maybe [AssetCashflow]
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 AssetCashflow
_ AssetCashflow
_ Maybe (Map CutoffFields Balance)
_) -> 
                              let 
                                 dName :: [Char]
dName = TestDeal a -> [Char]
forall a. TestDeal a -> [Char]
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 [Char] (ApplyAssumptionType, NonPerfAssumption)
assumpMap) -> [Char]
-> Map [Char] (ApplyAssumptionType, NonPerfAssumption)
-> Maybe (ApplyAssumptionType, NonPerfAssumption)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
dName Map [Char] (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 [Char] (AssetCashflow, Maybe [AssetCashflow]))
ranMap =   (PoolId
 -> (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
 -> Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Map
     PoolId (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
-> Map
     PoolId (Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\(DealBondFlow [Char]
dn [Char]
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 [([Char], Ts)]
-> Maybe [CallOpt]
-> Maybe RevolvingAssumption
-> Maybe [RateAssumption]
-> Maybe [InspectType]
-> Maybe RateReset
-> Maybe BondPricingInput
-> Maybe [(Date, DealCycle, [Char])]
-> Maybe (Date, IRate, Table Float IRate)
-> Maybe [TsPoint IssueBondEvent]
-> Maybe [TsPoint RefiEvent]
-> NonPerfAssumption
AP.NonPerfAssumption Maybe StopBy
forall a. Maybe a
Nothing Maybe [([Char], 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 RateReset
forall a. Maybe a
Nothing Maybe BondPricingInput
forall a. Maybe a
Nothing Maybe [(Date, DealCycle, [Char])]
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 AssetCashflow
_, [ResultComponent]
_, Map [Char] PriceResult
_,Map PoolId (AssetCashflow, Maybe [AssetCashflow])
_) <- TestDeal a
-> Set ExpectReturn
-> Maybe ApplyAssumptionType
-> NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
      Map [Char] PriceResult,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
TestDeal a
-> Set ExpectReturn
-> Maybe ApplyAssumptionType
-> NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, Map PoolId AssetCashflow, [ResultComponent],
      Map [Char] PriceResult,
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 [Char] [Txn] -> [[Txn]]
forall k a. Map k a -> [a]
Map.elems (Map [Char] [Txn] -> [[Txn]]) -> Map [Char] [Txn] -> [[Txn]]
forall a b. (a -> b) -> a -> b
$ (Maybe Statement -> [Txn])
-> Map [Char] (Maybe Statement) -> Map [Char] [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 [Char] (Maybe Statement) -> Map [Char] [Txn])
-> Map [Char] (Maybe Statement) -> Map [Char] [Txn]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Maybe FeeNames -> Map [Char] (Maybe Statement)
forall a.
SPV a =>
a -> Maybe FeeNames -> Map [Char] (Maybe Statement)
getBondStmtByName TestDeal a
dealRunned (FeeNames -> Maybe FeeNames
forall a. a -> Maybe a
Just [[Char]
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 
                                      (AssetCashflow, Maybe [AssetCashflow])
-> Either [Char] (AssetCashflow, Maybe [AssetCashflow])
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (BeginStatus -> [TsRow] -> AssetCashflow
CF.CashFlowFrame (Balance
0,Date
sd,Maybe Balance
forall a. Maybe a
Nothing) [TsRow]
bondFlowRated, Maybe [AssetCashflow]
forall a. Maybe a
Nothing))
                                 Map
  PoolId (TestDeal a, Maybe (ApplyAssumptionType, NonPerfAssumption))
assumpMap
    in
      Map PoolId (Either [Char] (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 [Char] (AssetCashflow, Maybe [AssetCashflow]))
ranMap
    

getInits :: Ast.Asset a => S.Set ExpectReturn -> TestDeal a -> Maybe AP.ApplyAssumptionType -> Maybe AP.NonPerfAssumption 
         -> Either String (TestDeal a,[ActionOnDate], Map.Map PoolId CF.PoolCashflow, Map.Map PoolId CF.PoolCashflow)
getInits :: forall a.
Asset a =>
Set ExpectReturn
-> TestDeal a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char]
     (TestDeal a, [ActionOnDate],
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]),
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
getInits Set ExpectReturn
er t :: TestDeal a
t@TestDeal{fees :: forall a. TestDeal a -> Map [Char] Fee
fees=Map [Char] 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 [Char] Bond
bonds=Map [Char] 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 RateReset
dp DealStats
ds) = [ Date -> [DealStats] -> ActionOnDate
InspectDS Date
_d [DealStats
ds] | Date
_d <- RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
II Date
sd RateReset
dp Date
ed ]
    expandInspect Date
sd Date
ed (AP.InspectRpt RateReset
dp [DealStats]
dss) = [ Date -> [DealStats] -> ActionOnDate
InspectDS Date
_d [DealStats]
dss | Date
_d <- RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
II Date
sd RateReset
dp Date
ed ] 
  in 
    do 
      (Date
startDate,Date
closingDate,Date
firstPayDate,[ActionOnDate]
pActionDates,[ActionOnDate]
bActionDates,Date
endDate,[ActionOnDate]
custWdates) <- DateDesp
-> DealStatus
-> Either
     [Char]
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
populateDealDates (TestDeal a -> DateDesp
forall a. TestDeal a -> DateDesp
dates TestDeal a
t) DealStatus
status

      let intEarnDates :: [([Char], [Date])]
intEarnDates = [Account] -> Date -> [([Char], [Date])] -> [([Char], [Date])]
A.buildEarnIntAction (Map [Char] Account -> [Account]
forall k a. Map k a -> [a]
Map.elems (TestDeal a -> Map [Char] Account
forall a. TestDeal a -> Map [Char] Account
accounts TestDeal a
t)) Date
endDate [] 
      let intAccRateResetDates :: [Maybe ([Char], [Date])]
intAccRateResetDates = (Date -> Account -> Maybe ([Char], [Date])
A.buildRateResetDates Date
endDate) (Account -> Maybe ([Char], [Date]))
-> [Account] -> [Maybe ([Char], [Date])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map [Char] Account -> [Account]
forall k a. Map k a -> [a]
Map.elems (TestDeal a -> Map [Char] Account
forall a. TestDeal a -> Map [Char] Account
accounts TestDeal a
t))
      let iAccIntDates :: [ActionOnDate]
iAccIntDates = [ Date -> [Char] -> ActionOnDate
EarnAccInt Date
_d [Char]
accName | ([Char]
accName,[Date]
accIntDates) <- [([Char], [Date])]
intEarnDates , Date
_d <- [Date]
accIntDates ] 
      let iAccRateResetDates :: [ActionOnDate]
iAccRateResetDates = [[ActionOnDate]] -> [ActionOnDate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Date -> [Char] -> ActionOnDate
ResetAccRate Date
_d [Char]
accName | Date
_d <- [Date]
_ds] | rst :: Maybe ([Char], [Date])
rst@(Just ([Char]
accName, [Date]
_ds)) <- [Maybe ([Char], [Date])]
intAccRateResetDates, Maybe ([Char], [Date]) -> Bool
forall a. Maybe a -> Bool
isJust Maybe ([Char], [Date])
rst ]
    
      --fee accrue dates 
      let _feeAccrueDates :: [([Char], [Date])]
_feeAccrueDates = [Fee] -> Date -> [([Char], [Date])] -> [([Char], [Date])]
F.buildFeeAccrueAction (Map [Char] Fee -> [Fee]
forall k a. Map k a -> [a]
Map.elems Map [Char] Fee
feeMap) Date
endDate [] 
      let feeAccrueDates :: [ActionOnDate]
feeAccrueDates = [ Date -> [Char] -> ActionOnDate
AccrueFee Date
_d [Char]
_feeName | ([Char]
_feeName,[Date]
feeAccureDates) <- [([Char], [Date])]
_feeAccrueDates , Date
_d <- [Date]
feeAccureDates ]
    --liquidation facility
      let liqResetDates :: [ActionOnDate]
liqResetDates = case TestDeal a -> Maybe (Map [Char] LiqFacility)
forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider TestDeal a
t of 
                        Maybe (Map [Char] LiqFacility)
Nothing -> []
                        Just Map [Char] LiqFacility
mLiqProvider -> 
                            let 
                              _liqResetDates :: [([Char], [Date])]
_liqResetDates = [LiqFacility] -> Date -> [([Char], [Date])] -> [([Char], [Date])]
CE.buildLiqResetAction (Map [Char] LiqFacility -> [LiqFacility]
forall k a. Map k a -> [a]
Map.elems Map [Char] LiqFacility
mLiqProvider) Date
endDate []
                              _liqRateResetDates :: [([Char], [Date])]
_liqRateResetDates = [LiqFacility] -> Date -> [([Char], [Date])] -> [([Char], [Date])]
CE.buildLiqRateResetAction (Map [Char] LiqFacility -> [LiqFacility]
forall k a. Map k a -> [a]
Map.elems Map [Char] LiqFacility
mLiqProvider) Date
endDate []
                            in 
                              [ Date -> [Char] -> ActionOnDate
ResetLiqProvider Date
_d [Char]
_liqName |([Char]
_liqName,[Date]
__liqResetDates) <- [([Char], [Date])]
_liqResetDates , Date
_d <- [Date]
__liqResetDates ]
                              [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ 
                              [ Date -> [Char] -> ActionOnDate
ResetLiqProviderRate Date
_d [Char]
_liqName |([Char]
_liqName,[Date]
__liqResetDates) <- [([Char], [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 RateReset
AP.buildFinancialReport= Just RateReset
dp } 
                              -> let 
                                   (Date
s:[Date]
_ds) = RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
II Date
startDate RateReset
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 [Char] RateSwap)
forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap TestDeal a
t of
                          Maybe (Map [Char] RateSwap)
Nothing -> []
                          Just Map [Char] RateSwap
rsm -> Map [Char] [ActionOnDate] -> [[ActionOnDate]]
forall k a. Map k a -> [a]
Map.elems (Map [Char] [ActionOnDate] -> [[ActionOnDate]])
-> Map [Char] [ActionOnDate] -> [[ActionOnDate]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> RateSwap -> [ActionOnDate])
-> Map [Char] RateSwap -> Map [Char] [ActionOnDate]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
                                                   (\[Char]
k RateSwap
x -> let 
                                                             resetDs :: [Date]
resetDs = RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
EE (RateSwap -> Date
HE.rsStartDate RateSwap
x) (RateSwap -> RateReset
HE.rsUpdateDates RateSwap
x) Date
endDate
                                                            in 
                                                             (Date -> [Char] -> ActionOnDate) -> [Char] -> Date -> ActionOnDate
forall a b c. (a -> b -> c) -> b -> a -> c
flip Date -> [Char] -> ActionOnDate
CalcIRSwap [Char]
k (Date -> ActionOnDate) -> [Date] -> [ActionOnDate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date]
resetDs)
                                                   Map [Char] RateSwap
rsm
      let irSettleSwapDates :: [[ActionOnDate]]
irSettleSwapDates = case TestDeal a -> Maybe (Map [Char] RateSwap)
forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap TestDeal a
t of
                          Maybe (Map [Char] RateSwap)
Nothing -> []
                          Just Map [Char] RateSwap
rsm -> Map [Char] [ActionOnDate] -> [[ActionOnDate]]
forall k a. Map k a -> [a]
Map.elems (Map [Char] [ActionOnDate] -> [[ActionOnDate]])
-> Map [Char] [ActionOnDate] -> [[ActionOnDate]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> RateSwap -> [ActionOnDate])
-> Map [Char] RateSwap -> Map [Char] [ActionOnDate]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
                                                    (\[Char]
k x :: RateSwap
x@HE.RateSwap{ rsSettleDates :: RateSwap -> Maybe (RateReset, [Char])
HE.rsSettleDates = Maybe (RateReset, [Char])
sDates} ->
                                                      case Maybe (RateReset, [Char])
sDates of 
                                                        Maybe (RateReset, [Char])
Nothing -> []
                                                        Just (RateReset
sdp,[Char]
_) ->
                                                          let 
                                                            resetDs :: [Date]
resetDs = RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
EE (RateSwap -> Date
HE.rsStartDate RateSwap
x) RateReset
sdp Date
endDate
                                                          in 
                                                            (Date -> [Char] -> ActionOnDate) -> [Char] -> Date -> ActionOnDate
forall a b c. (a -> b -> c) -> b -> a -> c
flip Date -> [Char] -> ActionOnDate
SettleIRSwap [Char]
k (Date -> ActionOnDate) -> [Date] -> [ActionOnDate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date]
resetDs)
                                                    Map [Char] RateSwap
rsm
      let rateCapSettleDates :: [[ActionOnDate]]
rateCapSettleDates = case TestDeal a -> Maybe (Map [Char] RateCap)
forall a. TestDeal a -> Maybe (Map [Char] RateCap)
rateCap TestDeal a
t of 
                             Maybe (Map [Char] RateCap)
Nothing -> []
                             Just Map [Char] RateCap
rcM -> Map [Char] [ActionOnDate] -> [[ActionOnDate]]
forall k a. Map k a -> [a]
Map.elems (Map [Char] [ActionOnDate] -> [[ActionOnDate]])
-> Map [Char] [ActionOnDate] -> [[ActionOnDate]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> RateCap -> [ActionOnDate])
-> Map [Char] RateCap -> Map [Char] [ActionOnDate]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey 
                                                       (\[Char]
k RateCap
x -> let 
                                                                  resetDs :: [Date]
resetDs = RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
EE (RateCap -> Date
HE.rcStartDate RateCap
x) (RateCap -> RateReset
HE.rcSettleDates RateCap
x) Date
endDate
                                                                in 
                                                                  (Date -> [Char] -> ActionOnDate) -> [Char] -> Date -> ActionOnDate
forall a b c. (a -> b -> c) -> b -> a -> c
flip Date -> [Char] -> ActionOnDate
AccrueCapRate [Char]
k (Date -> ActionOnDate) -> [Date] -> [ActionOnDate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date]
resetDs)
                                                       Map [Char] RateCap
rcM
    -- bond rate resets 
      let bndRateResets :: [ActionOnDate]
bndRateResets = let 
                        bndWithDate :: [([Char], [Date])]
bndWithDate = Map [Char] [Date] -> [([Char], [Date])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] [Date] -> [([Char], [Date])])
-> Map [Char] [Date] -> [([Char], [Date])]
forall a b. (a -> b) -> a -> b
$ (Bond -> [Date]) -> Map [Char] Bond -> Map [Char] [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 [Char] Bond
bndMap
                      in 
                        [ Date -> [Char] -> ActionOnDate
ResetBondRate Date
bdate [Char]
bn | ([Char]
bn, [Date]
bdates) <- [([Char], [Date])]
bndWithDate
                                                    , Date
bdate <- [Date]
bdates ] 

    -- bond step ups events
      let bndStepUpDates :: [ActionOnDate]
bndStepUpDates = let 
                        bndWithDate :: [([Char], [Date])]
bndWithDate = Map [Char] [Date] -> [([Char], [Date])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] [Date] -> [([Char], [Date])])
-> Map [Char] [Date] -> [([Char], [Date])]
forall a b. (a -> b) -> a -> b
$ (Bond -> [Date]) -> Map [Char] Bond -> Map [Char] [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 [Char] Bond
bndMap
                      in
                        [ Date -> [Char] -> ActionOnDate
StepUpBondRate Date
bdate [Char]
bn  | ([Char]
bn, [Date]
bdates) <- [([Char], [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, [Char])]
AP.fireTrigger = Just [(Date, DealCycle, [Char])]
evts} -> [ Date -> DealCycle -> [Char] -> ActionOnDate
FireTrigger Date
d DealCycle
cycle [Char]
n | (Date
d,DealCycle
cycle,[Char]
n) <- [(Date, DealCycle, [Char])]
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
-> [Char]
-> [Char]
-> Bond
-> Maybe DealStats
-> Maybe DealStats
-> ActionOnDate
IssueBond Date
_d Maybe Pre
mPre [Char]
bGroupName [Char]
accName Bond
b Maybe DealStats
mBal Maybe DealStats
mRate | TsPoint Date
_d (AP.IssueBondEvent Maybe Pre
mPre [Char]
bGroupName [Char]
accName Bond
b Maybe DealStats
mBal Maybe DealStats
mRate) <- [TsPoint IssueBondEvent]
bndPlan]
                                  [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ [Date -> Maybe Pre -> [Char] -> [Char] -> Balance -> ActionOnDate
FundBond Date
_d Maybe Pre
mPre [Char]
bName [Char]
accName Balance
amount | TsPoint Date
_d (AP.FundingBondEvent Maybe Pre
mPre [Char]
bName [Char]
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 -> [Char] -> [Char] -> InterestInfo -> ActionOnDate
RefiBondRate Date
_d [Char]
accName [Char]
bName InterestInfo
iInfo | TsPoint Date
_d (AP.RefiRate [Char]
accName [Char]
bName InterestInfo
iInfo) <- [TsPoint RefiEvent]
bndPlan]
                            [ActionOnDate] -> [ActionOnDate] -> [ActionOnDate]
forall a. [a] -> [a] -> [a]
++ [ Date -> [Char] -> Bond -> ActionOnDate
RefiBond Date
_d [Char]
accName Bond
bnd | TsPoint Date
_d (AP.RefiBond [Char]
accName Bond
bnd) <- [TsPoint RefiEvent]
bndPlan] 
                             
                        Maybe NonPerfAssumption
_ -> []

      let extractTestDates :: CallOpt -> [ActionOnDate]
extractTestDates (AP.CallOnDates RateReset
dp [Pre]
_) = [Date -> ActionOnDate
TestCall Date
x | Date
x <- RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
EE Date
startDate RateReset
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 RateReset
dp [Pre]
pres)} 
			    	-> [Date -> [Pre] -> ActionOnDate
StopRunTest Date
d [Pre]
pres | Date
d <- RangeType -> Date -> RateReset -> Date -> [Date]
genSerialDatesTill2 RangeType
EI Date
startDate RateReset
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 [Char] Fee
newFeeMap = case Maybe NonPerfAssumption
mNonPerfAssump of
                        Maybe NonPerfAssumption
Nothing -> Map [Char] Fee
feeMap
                        Just AP.NonPerfAssumption{projectedExpense :: NonPerfAssumption -> Maybe [([Char], Ts)]
AP.projectedExpense = Maybe [([Char], Ts)]
Nothing } -> Map [Char] Fee
feeMap
                        Just AP.NonPerfAssumption{projectedExpense :: NonPerfAssumption -> Maybe [([Char], Ts)]
AP.projectedExpense = Just [([Char], Ts)]
pairs } 
                          ->   (([Char], Ts) -> Map [Char] Fee -> Map [Char] Fee)
-> Map [Char] Fee -> [([Char], Ts)] -> Map [Char] Fee
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr  (\([Char]
feeName,Ts
feeFlow) Map [Char] Fee
accM -> (Fee -> Fee) -> [Char] -> Map [Char] Fee -> Map [Char] 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}) [Char]
feeName Map [Char] Fee
accM)  Map [Char] Fee
feeMap [([Char], Ts)]
pairs
      Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM <- Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
runPoolType Bool
True PoolType a
thePool Maybe ApplyAssumptionType
mAssumps Maybe NonPerfAssumption
mNonPerfAssump
      Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pScheduleCfM <- Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a.
Asset a =>
Bool
-> PoolType a
-> Maybe ApplyAssumptionType
-> Maybe NonPerfAssumption
-> Either
     [Char] (Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
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 (AssetCashflow, Maybe [AssetCashflow])
pCollectionCfAfterCutoff = ((AssetCashflow, Maybe [AssetCashflow])
 -> (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                       (\(AssetCashflow
pCf, Maybe [AssetCashflow]
mAssetFlow) -> 
					let 
                                          pCf' :: AssetCashflow
pCf' = Date -> [Date] -> AssetCashflow -> AssetCashflow
CF.cutoffCashflow Date
startDate [Date]
aggDates AssetCashflow
pCf
					in
					  (AssetCashflow
pCf' ,(\[AssetCashflow]
xs -> [ Date -> [Date] -> AssetCashflow -> AssetCashflow
CF.cutoffCashflow Date
startDate [Date]
aggDates AssetCashflow
x | AssetCashflow
x <- [AssetCashflow]
xs ] ) ([AssetCashflow] -> [AssetCashflow])
-> Maybe [AssetCashflow] -> Maybe [AssetCashflow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [AssetCashflow]
mAssetFlow)
	                               )
                                       Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCfM
	
      -- let pTxnOfSpv = Map.map (\((CF.CashFlowFrame _ txns, pstats), mAssetFlow) -> cutBy Inc Future startDate txns) pScheduleCfM
      -- let pAggCfM = Map.map 
      -- 			(\case
      --                     [] -> [] 
      --                     (x:xs) -> buildBegTsRow startDate x:x:xs)
      --   		pTxnOfSpv  
      -- let pUnstressedAfterCutoff = Map.map (CF.CashFlowFrame (0,startDate,Nothing)) pAggCfM
      let pUnstressedAfterCutoff :: Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pUnstressedAfterCutoff = ((AssetCashflow, Maybe [AssetCashflow])
 -> (AssetCashflow, Maybe [AssetCashflow]))
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                       (\(AssetCashflow
pCf, Maybe [AssetCashflow]
mAssetFlow) -> 
					let 
					  pCf' :: AssetCashflow
pCf' = Date -> [Date] -> AssetCashflow -> AssetCashflow
CF.cutoffCashflow Date
startDate [Date]
aggDates AssetCashflow
pCf
					in 
				          (AssetCashflow
pCf'
					   ,(\[AssetCashflow]
xs -> [ Date -> [Date] -> AssetCashflow -> AssetCashflow
CF.cutoffCashflow Date
startDate [Date]
aggDates AssetCashflow
x | AssetCashflow
x <- [AssetCashflow]
xs ]) ([AssetCashflow] -> [AssetCashflow])
-> Maybe [AssetCashflow] -> Maybe [AssetCashflow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [AssetCashflow]
mAssetFlow)
	                               )
                                       Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pScheduleCfM

      let poolWithSchedule :: PoolType a
poolWithSchedule = Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> PoolType a -> PoolType a
forall a.
Asset a =>
Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> PoolType a -> PoolType a
patchScheduleFlow Map PoolId (AssetCashflow, Maybe [AssetCashflow])
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 
				      ((\(AssetCashflow
_pflow,Maybe [AssetCashflow]
_) -> AssetCashflow -> Balance
CF.getBegBalCashFlowFrame AssetCashflow
_pflow) ((AssetCashflow, Maybe [AssetCashflow]) -> Balance)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
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 
                                     (((AssetCashflow, Maybe [AssetCashflow]) -> Balance)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> 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 [AssetCashflow]
_) -> Balance
b) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
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 (AssetCashflow, Maybe [AssetCashflow]),
 Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
-> Either
     [Char]
     (TestDeal a, [ActionOnDate],
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]),
      Map PoolId (AssetCashflow, Maybe [AssetCashflow]))
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t {fees = newFeeMap , pool = poolWithRunPoolBalance , stats = newStat}
             , [ActionOnDate]
allActionDates
             , Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pCollectionCfAfterCutoff
             , Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pUnstressedAfterCutoff)

-- ^ UI translation : to read pool cash
readProceeds :: PoolSource -> CF.TsRow -> Either String Balance
readProceeds :: PoolSource -> TsRow -> Either [Char] Balance
readProceeds PoolSource
CollectedInterest TsRow
x = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowInterest TsRow
x
readProceeds PoolSource
CollectedPrincipal TsRow
x = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowPrincipal TsRow
x
readProceeds PoolSource
CollectedRecoveries TsRow
x = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowRecovery TsRow
x
readProceeds PoolSource
CollectedPrepayment TsRow
x = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowPrepayment TsRow
x
readProceeds PoolSource
CollectedRental  TsRow
x    = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowRental TsRow
x
readProceeds PoolSource
CollectedPrepaymentPenalty TsRow
x = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowPrepaymentPenalty TsRow
x
readProceeds PoolSource
CollectedCash TsRow
x = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.tsTotalCash TsRow
x
readProceeds PoolSource
CollectedFeePaid TsRow
x = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowFeePaid TsRow
x
readProceeds PoolSource
a TsRow
_ = [Char] -> Either [Char] Balance
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Balance)
-> [Char] -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ [Char]
" Failed to find pool cashflow field from pool cashflow rule "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++PoolSource -> [Char]
forall a. Show a => a -> [Char]
show PoolSource
a


extractTxnsFromFlowFrameMap :: Maybe [PoolId] -> Map.Map PoolId CF.PoolCashflow -> [CF.TsRow]
extractTxnsFromFlowFrameMap :: Maybe [PoolId]
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxnsFromFlowFrameMap Maybe [PoolId]
mPids Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pflowMap = 
  let 
    extractTxns :: Map.Map PoolId CF.PoolCashflow -> [CF.TsRow]
    extractTxns :: Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxns Map PoolId (AssetCashflow, Maybe [AssetCashflow])
m = [[TsRow]] -> [TsRow]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TsRow]] -> [TsRow]) -> [[TsRow]] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ ((([TsRow] -> Const [TsRow] [TsRow])
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow]))
-> (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((AssetCashflow -> Const [TsRow] AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (AssetCashflow, Maybe [AssetCashflow])
  (AssetCashflow, Maybe [AssetCashflow])
  AssetCashflow
  AssetCashflow
_1 ((AssetCashflow -> Const [TsRow] AssetCashflow)
 -> (AssetCashflow, Maybe [AssetCashflow])
 -> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow]))
-> Getting [TsRow] AssetCashflow [TsRow]
-> ([TsRow] -> Const [TsRow] [TsRow])
-> (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [TsRow] AssetCashflow [TsRow]
Lens' AssetCashflow [TsRow]
CF.cashflowTxn)) ((AssetCashflow, Maybe [AssetCashflow]) -> [TsRow])
-> [(AssetCashflow, Maybe [AssetCashflow])] -> [[TsRow]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> [(AssetCashflow, Maybe [AssetCashflow])]
forall k a. Map k a -> [a]
Map.elems Map PoolId (AssetCashflow, Maybe [AssetCashflow])
m
  in 
    case Maybe [PoolId]
mPids of 
      Maybe [PoolId]
Nothing -> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxns Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pflowMap
      Just [PoolId]
pids -> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxns (Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
forall a b. (a -> b) -> a -> b
$ (PoolId -> (AssetCashflow, Maybe [AssetCashflow]) -> Bool)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PoolId
k (AssetCashflow, Maybe [AssetCashflow])
_ -> PoolId
k PoolId -> [PoolId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PoolId]
pids) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pflowMap

-- ^ deposit cash to account by collection rule
depositInflow :: Date -> W.CollectionRule -> Map.Map PoolId CF.PoolCashflow -> Map.Map AccountName A.Account -> Either String (Map.Map AccountName A.Account)
depositInflow :: Date
-> CollectionRule
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map [Char] Account
-> Either [Char] (Map [Char] Account)
depositInflow Date
d (W.Collect Maybe [PoolId]
mPids PoolSource
s [Char]
an) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map [Char] Account
amap 
  = do 
      [Balance]
amts <- [Either [Char] Balance] -> Either [Char] [Balance]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Balance] -> Either [Char] [Balance])
-> [Either [Char] Balance] -> Either [Char] [Balance]
forall a b. (a -> b) -> a -> b
$ PoolSource -> TsRow -> Either [Char] Balance
readProceeds PoolSource
s (TsRow -> Either [Char] Balance)
-> [TsRow] -> [Either [Char] Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
txns
      let amt :: Balance
amt = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
amts
      Map [Char] Account -> Either [Char] (Map [Char] Account)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map [Char] Account -> Either [Char] (Map [Char] Account))
-> Map [Char] Account -> Either [Char] (Map [Char] Account)
forall a b. (a -> b) -> a -> b
$ (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
amt Date
d (Maybe [PoolId] -> PoolSource -> TxnComment
PoolInflow Maybe [PoolId]
mPids PoolSource
s)) [Char]
an Map [Char] Account
amap
    where 
      txns :: [TsRow]
txns =  Maybe [PoolId]
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxnsFromFlowFrameMap Maybe [PoolId]
mPids Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap


depositInflow Date
d (W.CollectByPct Maybe [PoolId]
mPids PoolSource
s [(Rate, [Char])]
splitRules) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map [Char] Account
amap    --TODO need to check 100%
  = do 
      [Balance]
amts <- [Either [Char] Balance] -> Either [Char] [Balance]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Balance] -> Either [Char] [Balance])
-> [Either [Char] Balance] -> Either [Char] [Balance]
forall a b. (a -> b) -> a -> b
$ PoolSource -> TsRow -> Either [Char] Balance
readProceeds PoolSource
s (TsRow -> Either [Char] Balance)
-> [TsRow] -> [Either [Char] Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
txns
      let amt :: Balance
amt = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
amts
      let amtsToAccs :: [([Char], Balance)]
amtsToAccs = [ ([Char]
an, Balance -> Rate -> Balance
mulBR Balance
amt Rate
splitRate) | (Rate
splitRate, [Char]
an) <- [(Rate, [Char])]
splitRules]
      Map [Char] Account -> Either [Char] (Map [Char] Account)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map [Char] Account -> Either [Char] (Map [Char] Account))
-> Map [Char] Account -> Either [Char] (Map [Char] Account)
forall a b. (a -> b) -> a -> b
$ 
              (([Char], Balance) -> Map [Char] Account -> Map [Char] Account)
-> Map [Char] Account -> [([Char], Balance)] -> Map [Char] Account
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\([Char]
accName,Balance
accAmt) Map [Char] Account
accM -> 
                  (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
accAmt Date
d (Maybe [PoolId] -> PoolSource -> TxnComment
PoolInflow Maybe [PoolId]
mPids PoolSource
s)) [Char]
accName Map [Char] Account
accM)
                Map [Char] Account
amap
                [([Char], Balance)]
amtsToAccs
    where 
      txns :: [TsRow]
txns =  Maybe [PoolId]
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxnsFromFlowFrameMap Maybe [PoolId]
mPids Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap 

-- ^ deposit cash to account by pool map CF and rules
depositPoolFlow :: [W.CollectionRule] -> Date -> Map.Map PoolId CF.PoolCashflow -> Map.Map String A.Account -> Either String (Map.Map String A.Account)
depositPoolFlow :: [CollectionRule]
-> Date
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map [Char] Account
-> Either [Char] (Map [Char] Account)
depositPoolFlow [CollectionRule]
rules Date
d Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map [Char] Account
amap
  -- = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules
  = (Map [Char] Account
 -> CollectionRule -> Either [Char] (Map [Char] Account))
-> Map [Char] Account
-> [CollectionRule]
-> Either [Char] (Map [Char] Account)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map [Char] Account
acc CollectionRule
rule -> Date
-> CollectionRule
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map [Char] Account
-> Either [Char] (Map [Char] Account)
depositInflow Date
d CollectionRule
rule Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map [Char] Account
acc) Map [Char] Account
amap [CollectionRule]
rules

$(deriveJSON defaultOptions ''ExpectReturn)