{-# LANGUAGE ScopedTypeVariables #-}

module Deal.DealRun (
   run
   ,accrueRC
) where

import qualified Data.Set as S
import qualified Data.DList as DL
import Data.List
import Control.Lens hiding (element)
import Control.Lens.TH
import Control.Monad
import Data.Maybe
import Data.Either
import Data.Either.Utils
import Control.Monad.Loops (allM,anyM)

import qualified Asset as Ast
import qualified Cashflow as CF
import qualified Accounts as A
import qualified Data.Map as Map hiding (mapEither)
import qualified Waterfall as W
import qualified Liability as L
import qualified Reports as Rpt
import qualified Pool as P
import qualified Assumptions as AP
import qualified Hedge as HE
import qualified CreditEnhancement as CE
import qualified InterestRate as IR
import Triggers

import Deal.DealBase
import Deal.DealAction
import Deal.DealQuery
import Deal.DealCollection
import Revolving
import Hedge
import Stmt
import Types

import Util
import Lib
-- ^ 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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runEffects (t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map String Account
accounts = Map String Account
accMap, fees :: forall a. TestDeal a -> Map String Fee
fees = Map String Fee
feeMap ,status :: forall a. TestDeal a -> DealStatus
status=DealStatus
st, bonds :: forall a. TestDeal a -> Map String Bond
bonds = Map String 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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t {status = _ds}, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
logs)
      DoAccrueFee FeeNames
fns -> do
                           [Fee]
newFeeList <- [Either String Fee] -> Either String [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 String Fee] -> Either String [Fee])
-> [Either String Fee] -> Either String [Fee]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Date -> Fee -> Either String Fee
forall a. Asset a => TestDeal a -> Date -> Fee -> Either String Fee
calcDueFee TestDeal a
t Date
d  (Fee -> Either String Fee)
-> (String -> Fee) -> String -> Either String Fee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map String Fee
feeMap Map String Fee -> String -> Fee
forall k a. Ord k => Map k a -> k -> a
Map.!) (String -> Either String Fee) -> FeeNames -> [Either String Fee]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FeeNames
fns
                           let newFeeMap :: Map String Fee
newFeeMap = [(String, Fee)] -> Map String Fee
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (FeeNames -> [Fee] -> [(String, Fee)]
forall a b. [a] -> [b] -> [(a, b)]
zip FeeNames
fns [Fee]
newFeeList) Map String Fee -> Map String Fee -> Map String Fee
forall a. Semigroup a => a -> a -> a
<> Map String Fee
feeMap
                           (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t {fees = newFeeMap}, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
logs)
      ChangeReserveBalance String
accName ReserveAmount
rAmt ->
          (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
      String
      (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent))
-> (TestDeal a, RunContext a, [ActionOnDate],
    DList ResultComponent)
-> [TriggerEffect]
-> Either
     String
     (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     String
     (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 String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String 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 String
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 -> String -> Maybe Bond
forall a. Asset a => TestDeal a -> Bool -> String -> Maybe Bond
getBondByName TestDeal a
t' Bool
True String
bName of 
                        Just Bond
bnd -> [ Date -> String -> ActionOnDate
ResetBondRate Date
_d String
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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, RunContext a
rc, [ActionOnDate]
actions, DList ResultComponent
forall a. DList a
DL.empty)
      TriggerEffect
_ -> String
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. a -> Either a b
Left (String
 -> Either
      String
      (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent))
-> String
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a b. (a -> b) -> a -> b
$ String
"Date:"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Date -> String
forall a. Show a => a -> String
show Date
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" Failed to match trigger effects: "String -> String -> String
forall a. [a] -> [a] -> [a]
++TriggerEffect -> String
forall a. Show a => a -> String
show TriggerEffect
te

setBondStepUpRate :: Date -> [RateAssumption] -> L.Bond -> Either String L.Bond
setBondStepUpRate :: Date -> [RateAssumption] -> Bond -> Either String Bond
setBondStepUpRate Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond String
_ BondType
_ OriginalInfo
_ InterestInfo
ii (Just StepUp
sp) Balance
_ IRate
_ Balance
_ Balance
_ Balance
_ Maybe Date
_ Maybe Date
_ Maybe Date
_ Maybe Statement
_)
  = Bond -> Either String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either String Bond) -> Bond -> Either String 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
AP.applyFloatRate InterestInfo
ii Date
d [RateAssumption]
ras
      in 
        (Date -> Bond -> Bond
L.accrueInt Date
d Bond
b) { L.bndInterestInfo = newII, L.bndRate = newRate }

setBondStepUpRate Date
d [RateAssumption]
ras b :: Bond
b@(L.MultiIntBond String
bn BondType
_ OriginalInfo
_ [InterestInfo]
iis (Just [StepUp]
sps) Balance
_ [IRate]
_ Balance
_ [Balance]
_ [Balance]
_ Maybe Date
_ Maybe [Date]
_ Maybe Date
_ Maybe Statement
_)
  = Bond -> Either String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either String Bond) -> Bond -> Either String 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
AP.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 Date
d [RateAssumption]
ras bg :: Bond
bg@(L.BondGroup Map String Bond
bMap Maybe BondType
pt)
  = do 
      Map String Bond
m <- (Bond -> Either String Bond)
-> Map String Bond -> Either String (Map String 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 String a -> m (Map String b)
mapM (Date -> [RateAssumption] -> Bond -> Either String Bond
setBondStepUpRate Date
d [RateAssumption]
ras) Map String Bond
bMap
      Bond -> Either String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either String Bond) -> Bond -> Either String Bond
forall a b. (a -> b) -> a -> b
$ Map String Bond -> Maybe BondType -> Bond
L.BondGroup Map String Bond
m Maybe BondType
pt

-- ^ 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 String Bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond String
_ 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 String Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either String 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 String
_ 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 String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either String Bond) -> Bond -> Either String Bond
forall a b. (a -> b) -> a -> b
$ (Date -> Bond -> Bond
L.accrueInt Date
d Bond
b){ L.bndRate = AP.applyFloatRate ii d ras }

-- ^ Fix rate, do nothing
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond String
_ 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 String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Bond
b

-- ^ Ref rate
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras b :: Bond
b@(L.Bond String
_ 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
      Rational
rate <- TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
      Bond -> Either String Bond
forall a. a -> Either String 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 String
_ 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 String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either String Bond) -> Bond -> Either String Bond
forall a b. (a -> b) -> a -> b
$ (Date -> Bond -> Bond
L.accrueInt Date
d Bond
b) { L.bndRate = AP.applyFloatRate ii d ras}

-- ^ bond group
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras bg :: Bond
bg@(L.BondGroup Map String Bond
bMap Maybe BondType
pt)
  = do 
      Map String Bond
m <- (Bond -> Either String Bond)
-> Map String Bond -> Either String (Map String 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 String a -> m (Map String b)
mapM (TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either String Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either String Bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
ras) Map String Bond
bMap
      Bond -> Either String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either String Bond) -> Bond -> Either String Bond
forall a b. (a -> b) -> a -> b
$ Map String Bond -> Maybe BondType -> Bond
L.BondGroup Map String 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 String
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
AP.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 String Bond
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either String Bond) -> Bond -> Either String Bond
forall a b. (a -> b) -> a -> b
$ Bond
b' { L.bndRates = newRates } 

-- ^ 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 String 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 String RateCap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return RateCap
rc 
  | Bool
otherwise = do
                  IRate
r <- [RateAssumption] -> Index -> Date -> Either String IRate
AP.lookupRate0 [RateAssumption]
rs Index
index Date
d
                  Rational
balance <- case RateSwapBase
notional of
                               Fixed Balance
bal -> Rational -> Either String Rational
forall a b. b -> Either a b
Right (Rational -> Either String Rational)
-> (Balance -> Rational) -> Balance -> Either String Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Rational
forall a. Real a => a -> Rational
toRational (Balance -> Either String Rational)
-> Balance -> Either String Rational
forall a b. (a -> b) -> a -> b
$ Balance
bal
                               Base DealStats
ds -> TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                               Schedule Ts
ts -> Rational -> Either String Rational
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Either String Rational)
-> Rational -> Either String Rational
forall a b. (a -> b) -> a -> b
$ Ts -> CutoffType -> Date -> Rational
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
- Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational (Ts -> CutoffType -> Date -> Rational
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
IR.calcInt (Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational Rational
balance) Date
sd Date
d IRate
accRate DayCount
DC_ACT_365F
                                 Just Date
lstD -> Balance -> Date -> Date -> IRate -> DayCount -> Balance
IR.calcInt (Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational Rational
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 String RateCap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (RateCap -> Either String RateCap)
-> RateCap -> Either String RateCap
forall a b. (a -> b) -> a -> b
$ RateCap
rc { rcLastStlDate = Just d ,rcNetCash = newAmt, rcStmt = newStmt }

updateRateSwapBal :: Ast.Asset a => TestDeal a -> Date -> HE.RateSwap -> Either String HE.RateSwap
updateRateSwapBal :: forall a.
Asset a =>
TestDeal a -> Date -> RateSwap -> Either String 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 String RateSwap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return RateSwap
rs  
        HE.Schedule Ts
ts -> RateSwap -> Either String RateSwap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (RateSwap -> Either String RateSwap)
-> RateSwap -> Either String RateSwap
forall a b. (a -> b) -> a -> b
$ RateSwap
rs { HE.rsRefBalance = fromRational (getValByDate ts Inc d) }
        HE.Base DealStats
ds -> 
            do 
              Rational
v <- TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds) 
              RateSwap -> Either String RateSwap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return RateSwap
rs { HE.rsRefBalance = fromRational v} -- `debug` ("query Result"++ show (patchDateToStats d ds) )

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 String RateSwap
updateRateSwapRate TestDeal a
t Maybe [RateAssumption]
Nothing Date
_ RateSwap
_ = String -> Either String RateSwap
forall a b. a -> Either a b
Left String
"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 String IRate
getRate Floater
x = [RateAssumption] -> Floater -> Date -> Either String 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 String IRate
getRate Floater
flter1
                                  IRate
r2 <- Floater -> Either String IRate
getRate Floater
flter2
                                  (IRate, IRate) -> Either String (IRate, IRate)
forall a. a -> Either String 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 String IRate
getRate Floater
flter
                                  (IRate, IRate) -> Either String (IRate, IRate)
forall a. a -> Either String 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 String IRate
getRate Floater
flter
                                  (IRate, IRate) -> Either String (IRate, IRate)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate
r, IRate
_r)
                              HE.FormulaToFloating DealStats
ds Floater
flter -> 
                                do 
                                  Rational
_r <- TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                                  IRate
r <- Floater -> Either String IRate
getRate Floater
flter
                                  (IRate, IRate) -> Either String (IRate, IRate)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational Rational
_r, IRate
r)
                              HE.FloatingToFormula Floater
flter DealStats
ds -> 
                                do 
                                  IRate
r <- Floater -> Either String IRate
getRate Floater
flter
                                  Rational
_r <- TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                                  (IRate, IRate) -> Either String (IRate, IRate)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRate
r, Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational Rational
_r)
        RateSwap -> Either String RateSwap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return RateSwap
rs {HE.rsPayingRate = pRate, HE.rsReceivingRate = rRate }

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
AP.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
AP.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 }

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
     String
     (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 String Trigger))
triggers = Maybe (Map DealCycle (Map String Trigger))
Nothing},RunContext a
rc, [ActionOnDate]
actions) Date
d DealCycle
dcycle = (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (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 String Trigger))
triggers = Just Map DealCycle (Map String Trigger)
trgM},RunContext a
rc, [ActionOnDate]
actions) Date
d DealCycle
dcycle = 
  do
    let trgsMap :: Map String Trigger
trgsMap = Map String Trigger
-> DealCycle
-> Map DealCycle (Map String Trigger)
-> Map String Trigger
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map String Trigger
forall k a. Map k a
Map.empty DealCycle
dcycle Map DealCycle (Map String Trigger)
trgM
    let trgsToTest :: Map String Trigger
trgsToTest = (Trigger -> Bool) -> Map String Trigger -> Map String 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 String Trigger
trgsMap
    Map String Trigger
triggeredTrgs <- (Trigger -> Either String Trigger)
-> Map String Trigger -> Either String (Map String 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 String a -> m (Map String b)
mapM (TestDeal a -> Date -> Trigger -> Either String Trigger
forall a.
Asset a =>
TestDeal a -> Date -> Trigger -> Either String Trigger
testTrigger TestDeal a
t Date
d) Map String Trigger
trgsToTest
    let triggeredEffects :: [TriggerEffect]
triggeredEffects = [ Trigger -> TriggerEffect
trgEffects Trigger
_trg | Trigger
_trg <- Map String Trigger -> [Trigger]
forall k a. Map k a -> [a]
Map.elems Map String 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
      String
      (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent))
-> (TestDeal a, RunContext a, [ActionOnDate],
    DList ResultComponent)
-> [TriggerEffect]
-> Either
     String
     (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     String
     (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 -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
oldStatus DealStatus
newStatus String
"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 String Trigger
newTriggers = Map String Trigger -> Map String Trigger -> Map String Trigger
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map String Trigger
triggeredTrgs Map String Trigger
trgsMap
    (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String 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)

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 PoolCashflow -> TestDeal a
appendCollectedCF Date
d t :: TestDeal a
t@TestDeal { pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pt } Map PoolId PoolCashflow
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
 -> PoolCashflow -> Map PoolId (Pool a) -> Map PoolId (Pool a))
-> Map PoolId (Pool a)
-> Map PoolId PoolCashflow
-> 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 [CashFlowFrame]
mAssetFlow) Map PoolId (Pool a)
acc ->
                        let 
                          currentStats :: (Balance, Balance, Balance, Balance, Balance, Balance)
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 PoolCashflow -> Const [TsRow] (Maybe PoolCashflow))
-> Pool a -> Const [TsRow] (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureCf ((Maybe PoolCashflow -> Const [TsRow] (Maybe PoolCashflow))
 -> Pool a -> Const [TsRow] (Pool a))
-> (([TsRow] -> Const [TsRow] [TsRow])
    -> Maybe PoolCashflow -> Const [TsRow] (Maybe PoolCashflow))
-> Getting [TsRow] (Pool a) [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Const [TsRow] PoolCashflow)
-> Maybe PoolCashflow -> Const [TsRow] (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PoolCashflow -> Const [TsRow] PoolCashflow)
 -> Maybe PoolCashflow -> Const [TsRow] (Maybe PoolCashflow))
-> (([TsRow] -> Const [TsRow] [TsRow])
    -> PoolCashflow -> Const [TsRow] PoolCashflow)
-> ([TsRow] -> Const [TsRow] [TsRow])
-> Maybe PoolCashflow
-> Const [TsRow] (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Const [TsRow] CashFlowFrame)
-> PoolCashflow -> Const [TsRow] PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1 ((CashFlowFrame -> Const [TsRow] CashFlowFrame)
 -> PoolCashflow -> Const [TsRow] PoolCashflow)
-> (([TsRow] -> Const [TsRow] [TsRow])
    -> CashFlowFrame -> Const [TsRow] CashFlowFrame)
-> ([TsRow] -> Const [TsRow] [TsRow])
-> PoolCashflow
-> Const [TsRow] PoolCashflow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Const [TsRow] [TsRow])
-> CashFlowFrame -> Const [TsRow] CashFlowFrame
Lens' CashFlowFrame [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 -> (Balance, Balance, Balance, Balance, Balance, Balance)
forall a.
Pool a -> (Balance, Balance, Balance, Balance, Balance, Balance)
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 -> (Balance, Balance, Balance, Balance, Balance, Balance)
-> Maybe (Balance, Balance, Balance, Balance, Balance, Balance)
-> (Balance, Balance, Balance, Balance, Balance, Balance)
forall a. a -> Maybe a -> a
fromMaybe (Balance
0,Balance
0,Balance
0,Balance
0,Balance
0,Balance
0) (Maybe (Balance, Balance, Balance, Balance, Balance, Balance)
 -> (Balance, Balance, Balance, Balance, Balance, Balance))
-> Maybe (Balance, Balance, Balance, Balance, Balance, Balance)
-> (Balance, Balance, Balance, Balance, Balance, Balance)
forall a b. (a -> b) -> a -> b
$ Getting
  (Maybe (Balance, Balance, Balance, Balance, Balance, Balance))
  TsRow
  (Maybe (Balance, Balance, Balance, Balance, Balance, Balance))
-> TsRow
-> Maybe (Balance, Balance, Balance, Balance, Balance, Balance)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (Balance, Balance, Balance, Balance, Balance, Balance))
  TsRow
  (Maybe (Balance, Balance, Balance, Balance, Balance, Balance))
Lens'
  TsRow
  (Maybe (Balance, Balance, Balance, Balance, Balance, Balance))
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 = (Balance, Balance, Balance, Balance, Balance, Balance)
-> [TsRow] -> [TsRow] -> [TsRow]
CF.patchCumulative (Balance, Balance, Balance, Balance, Balance, Balance)
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 PoolCashflow
forall a. Pool a -> Maybe PoolCashflow
P.futureCf Pool a
_v) of
					            Maybe PoolCashflow
Nothing -> ASetter (Pool a) (Pool a) (Maybe PoolCashflow) (Maybe PoolCashflow)
-> Maybe PoolCashflow -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Pool a) (Pool a) (Maybe PoolCashflow) (Maybe PoolCashflow)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureCf (PoolCashflow -> Maybe PoolCashflow
forall a. a -> Maybe a
Just (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st [TsRow]
txnCollected , Maybe [CashFlowFrame]
forall a. Maybe a
Nothing)) Pool a
_v
						    Just PoolCashflow
_ -> 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 PoolCashflow) (Maybe PoolCashflow)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureCf ASetter (Pool a) (Pool a) (Maybe PoolCashflow) (Maybe PoolCashflow)
-> (([TsRow] -> Identity [TsRow])
    -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ASetter (Pool a) (Pool a) [TsRow] [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Identity PoolCashflow)
-> Maybe PoolCashflow -> Identity (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PoolCashflow -> Identity PoolCashflow)
 -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> (([TsRow] -> Identity [TsRow])
    -> PoolCashflow -> Identity PoolCashflow)
-> ([TsRow] -> Identity [TsRow])
-> Maybe PoolCashflow
-> Identity (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Identity CashFlowFrame)
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1 ((CashFlowFrame -> Identity CashFlowFrame)
 -> PoolCashflow -> Identity PoolCashflow)
-> (([TsRow] -> Identity [TsRow])
    -> CashFlowFrame -> Identity CashFlowFrame)
-> ([TsRow] -> Identity [TsRow])
-> PoolCashflow
-> Identity PoolCashflow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Identity [TsRow])
-> CashFlowFrame -> Identity CashFlowFrame
Lens' CashFlowFrame [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 [CashFlowFrame]
mAssetFlow of 
					  Maybe [CashFlowFrame]
Nothing -> Map PoolId (Pool a)
accUpdated
					  Just [CashFlowFrame]
collectedAssetFlow -> 
					    let 
					      appendFn :: Maybe [CashFlowFrame] -> Maybe [CashFlowFrame]
appendFn Maybe [CashFlowFrame]
Nothing = [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a. a -> Maybe a
Just [CashFlowFrame]
collectedAssetFlow   
					      appendFn (Just [CashFlowFrame]
cfs) 
					        | [CashFlowFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CashFlowFrame]
cfs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [CashFlowFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CashFlowFrame]
collectedAssetFlow 
	                                            = [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a. a -> Maybe a
Just ([CashFlowFrame] -> Maybe [CashFlowFrame])
-> [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a b. (a -> b) -> a -> b
$ [ CashFlowFrame
origin CashFlowFrame -> (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame
forall a b. a -> (a -> b) -> b
& (([TsRow] -> Identity [TsRow])
 -> CashFlowFrame -> Identity CashFlowFrame)
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ([TsRow] -> Identity [TsRow])
-> CashFlowFrame -> Identity CashFlowFrame
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn ([TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ ((([TsRow] -> Const [TsRow] [TsRow])
 -> CashFlowFrame -> Const [TsRow] CashFlowFrame)
-> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ([TsRow] -> Const [TsRow] [TsRow])
-> CashFlowFrame -> Const [TsRow] CashFlowFrame
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
new)) | (CashFlowFrame
origin,CashFlowFrame
new) <- [CashFlowFrame]
-> [CashFlowFrame] -> [(CashFlowFrame, CashFlowFrame)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CashFlowFrame]
cfs  [CashFlowFrame]
collectedAssetFlow ] 
						| [CashFlowFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CashFlowFrame]
collectedAssetFlow  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [CashFlowFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CashFlowFrame]
cfs 
                                                    = let 
                                                        dummyCashFrames :: [CashFlowFrame]
dummyCashFrames = Int -> CashFlowFrame -> [CashFlowFrame]
forall a. Int -> a -> [a]
replicate ([CashFlowFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CashFlowFrame]
collectedAssetFlow Int -> Int -> Int
forall a. Num a => a -> a -> a
- [CashFlowFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CashFlowFrame]
cfs) CashFlowFrame
CF.emptyCashflow 
						      in 
						        [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a. a -> Maybe a
Just ([CashFlowFrame] -> Maybe [CashFlowFrame])
-> [CashFlowFrame] -> Maybe [CashFlowFrame]
forall a b. (a -> b) -> a -> b
$ [ CashFlowFrame
origin CashFlowFrame -> (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame
forall a b. a -> (a -> b) -> b
& (([TsRow] -> Identity [TsRow])
 -> CashFlowFrame -> Identity CashFlowFrame)
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([TsRow] -> Identity [TsRow])
-> CashFlowFrame -> Identity CashFlowFrame
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn) ([TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ ((([TsRow] -> Const [TsRow] [TsRow])
 -> CashFlowFrame -> Const [TsRow] CashFlowFrame)
-> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ([TsRow] -> Const [TsRow] [TsRow])
-> CashFlowFrame -> Const [TsRow] CashFlowFrame
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
new)) | (CashFlowFrame
origin,CashFlowFrame
new) <- [CashFlowFrame]
-> [CashFlowFrame] -> [(CashFlowFrame, CashFlowFrame)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([CashFlowFrame]
cfs[CashFlowFrame] -> [CashFlowFrame] -> [CashFlowFrame]
forall a. [a] -> [a] -> [a]
++[CashFlowFrame]
dummyCashFrames) [CashFlowFrame]
collectedAssetFlow ]
						| Bool
otherwise = String -> Maybe [CashFlowFrame]
forall a. HasCallStack => String -> a
error String
"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 [CashFlowFrame]) (Maybe [CashFlowFrame])
-> (Maybe [CashFlowFrame] -> Maybe [CashFlowFrame])
-> 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 PoolCashflow) (Maybe PoolCashflow)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureCf ASetter (Pool a) (Pool a) (Maybe PoolCashflow) (Maybe PoolCashflow)
-> ((Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
    -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ASetter
     (Pool a) (Pool a) (Maybe [CashFlowFrame]) (Maybe [CashFlowFrame])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Identity PoolCashflow)
-> Maybe PoolCashflow -> Identity (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PoolCashflow -> Identity PoolCashflow)
 -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ((Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
    -> PoolCashflow -> Identity PoolCashflow)
-> (Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
-> Maybe PoolCashflow
-> Identity (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [CashFlowFrame] -> Identity (Maybe [CashFlowFrame]))
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  PoolCashflow
  PoolCashflow
  (Maybe [CashFlowFrame])
  (Maybe [CashFlowFrame])
_2) Maybe [CashFlowFrame] -> Maybe [CashFlowFrame]
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 PoolCashflow
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
 -> PoolCashflow
 -> Map PoolId (UnderlyingDeal a)
 -> Map PoolId (UnderlyingDeal a))
-> Map PoolId (UnderlyingDeal a)
-> Map PoolId PoolCashflow
-> 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 [CashFlowFrame]
_) 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)
  (Maybe CashFlowFrame)
  (Maybe CashFlowFrame)
-> (Maybe CashFlowFrame -> Maybe CashFlowFrame)
-> UnderlyingDeal a
-> UnderlyingDeal a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (UnderlyingDeal a)
  (UnderlyingDeal a)
  (Maybe CashFlowFrame)
  (Maybe CashFlowFrame)
forall a. Asset a => Lens' (UnderlyingDeal a) (Maybe CashFlowFrame)
Lens' (UnderlyingDeal a) (Maybe CashFlowFrame)
uDealFutureCf (Maybe CashFlowFrame -> [TsRow] -> Maybe CashFlowFrame
`CF.appendMCashFlow` [TsRow]
newTxns)) PoolId
k Map PoolId (UnderlyingDeal a)
acc)
                      Map PoolId (UnderlyingDeal a)
uds
		      Map PoolId PoolCashflow
poolInflowMap
    in 
      TestDeal a
t {pool = newPt}  --  `debug` ("after insert bal"++ show newPt)


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 PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run t :: TestDeal a
t@TestDeal{status :: forall a. TestDeal a -> DealStatus
status=(Ended Maybe Date
endedDate)} Map PoolId PoolCashflow
pCfM Maybe [ActionOnDate]
ads Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map String (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun Maybe Date
endedDate String
"By Status:Ended"), Map PoolId PoolCashflow
pCfM)
run TestDeal a
t Map PoolId PoolCashflow
pCfM (Just []) Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map String (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun Maybe Date
forall a. Maybe a
Nothing String
"No Actions"), Map PoolId PoolCashflow
pCfM)
run TestDeal a
t Map PoolId PoolCashflow
pCfM (Just [HitStatedMaturity Date
d]) Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map String (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) String
"Stop: Stated Maturity"), Map PoolId PoolCashflow
pCfM)
run TestDeal a
t Map PoolId PoolCashflow
pCfM (Just (StopRunFlag Date
d:[ActionOnDate]
_)) Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map String (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log  = (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) String
"Stop Run Flag"), Map PoolId PoolCashflow
pCfM)
run t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map String Account
accounts=Map String Account
accMap,fees :: forall a. TestDeal a -> Map String Fee
fees=Map String Fee
feeMap,triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map String Trigger))
triggers=Maybe (Map DealCycle (Map String Trigger))
mTrgMap,bonds :: forall a. TestDeal a -> Map String Bond
bonds=Map String 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 -> String
name=String
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 PoolCashflow
poolFlowMap (Just (ActionOnDate
ad:[ActionOnDate]
ads)) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
  | Bool
futureCashToCollectFlag Bool -> Bool -> Bool
&& (TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
ad) DealStats
AllAccBalance Either String Rational -> Either String Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational -> Either String Rational
forall a b. b -> Either a b
Right Rational
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 PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId PoolCashflow
poolFlowMap Maybe (Map String (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 String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
ad)) (TestDeal a
t,RunContext a
forall {a}. RunContext a
runContext,DList ResultComponent
log) [Action]
cleanUpActions 
        (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
ad)) String
"No Pool Cashflow/All Account is zero/Not revolving")
                , Map PoolId PoolCashflow
poolFlowMap)
  | Bool
otherwise
    = case ActionOnDate
ad of 
        PoolCollection Date
d String
_ ->
          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
  ((CashFlowFrame, CashFlowFrame),
   Maybe [(CashFlowFrame, CashFlowFrame)])
cutOffPoolFlowMap = (PoolCashflow
 -> ((CashFlowFrame, CashFlowFrame),
     Maybe [(CashFlowFrame, CashFlowFrame)]))
-> Map PoolId PoolCashflow
-> Map
     PoolId
     ((CashFlowFrame, CashFlowFrame),
      Maybe [(CashFlowFrame, CashFlowFrame)])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(CashFlowFrame
pflow,Maybe [CashFlowFrame]
mAssetFlow) -> 
                                            (CashFlowFrame
-> Date -> SplitType -> (CashFlowFrame, CashFlowFrame)
CF.splitCashFlowFrameByDate CashFlowFrame
pflow Date
d SplitType
EqToLeft
                                              ,(\[CashFlowFrame]
xs -> [ CashFlowFrame
-> Date -> SplitType -> (CashFlowFrame, CashFlowFrame)
CF.splitCashFlowFrameByDate CashFlowFrame
x Date
d SplitType
EqToLeft | CashFlowFrame
x <- [CashFlowFrame]
xs ]) ([CashFlowFrame] -> [(CashFlowFrame, CashFlowFrame)])
-> Maybe [CashFlowFrame] -> Maybe [(CashFlowFrame, CashFlowFrame)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CashFlowFrame]
mAssetFlow))
                                          Map PoolId PoolCashflow
poolFlowMap 
              collectedFlow :: Map PoolId PoolCashflow
collectedFlow =  (((CashFlowFrame, CashFlowFrame),
  Maybe [(CashFlowFrame, CashFlowFrame)])
 -> PoolCashflow)
-> Map
     PoolId
     ((CashFlowFrame, CashFlowFrame),
      Maybe [(CashFlowFrame, CashFlowFrame)])
-> Map PoolId PoolCashflow
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\((CashFlowFrame, CashFlowFrame)
p,Maybe [(CashFlowFrame, CashFlowFrame)]
mAstFlow) -> ((CashFlowFrame, CashFlowFrame) -> CashFlowFrame
forall a b. (a, b) -> a
fst (CashFlowFrame, CashFlowFrame)
p, (\[(CashFlowFrame, CashFlowFrame)]
xs -> [ (CashFlowFrame, CashFlowFrame) -> CashFlowFrame
forall a b. (a, b) -> a
fst (CashFlowFrame, CashFlowFrame)
x | (CashFlowFrame, CashFlowFrame)
x <- [(CashFlowFrame, CashFlowFrame)]
xs ]) ([(CashFlowFrame, CashFlowFrame)] -> [CashFlowFrame])
-> Maybe [(CashFlowFrame, CashFlowFrame)] -> Maybe [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(CashFlowFrame, CashFlowFrame)]
mAstFlow)) Map
  PoolId
  ((CashFlowFrame, CashFlowFrame),
   Maybe [(CashFlowFrame, CashFlowFrame)])
cutOffPoolFlowMap  -- `debug` ("PoolCollection : "++ show d ++  " splited"++ show cutOffPoolFlowMap++"\n input pflow"++ show poolFlowMap)
              -- outstandingFlow = Map.map (CF.insertBegTsRow d . snd) cutOffPoolFlowMap
              outstandingFlow :: Map PoolId PoolCashflow
outstandingFlow = (((CashFlowFrame, CashFlowFrame),
  Maybe [(CashFlowFrame, CashFlowFrame)])
 -> PoolCashflow)
-> Map
     PoolId
     ((CashFlowFrame, CashFlowFrame),
      Maybe [(CashFlowFrame, CashFlowFrame)])
-> Map PoolId PoolCashflow
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\((CashFlowFrame, CashFlowFrame)
p,Maybe [(CashFlowFrame, CashFlowFrame)]
mAstFlow) -> ((CashFlowFrame, CashFlowFrame) -> CashFlowFrame
forall a b. (a, b) -> b
snd (CashFlowFrame, CashFlowFrame)
p, (\[(CashFlowFrame, CashFlowFrame)]
xs -> [ (CashFlowFrame, CashFlowFrame) -> CashFlowFrame
forall a b. (a, b) -> b
snd (CashFlowFrame, CashFlowFrame)
x | (CashFlowFrame, CashFlowFrame)
x <- [(CashFlowFrame, CashFlowFrame)]
xs ]) ([(CashFlowFrame, CashFlowFrame)] -> [CashFlowFrame])
-> Maybe [(CashFlowFrame, CashFlowFrame)] -> Maybe [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(CashFlowFrame, CashFlowFrame)]
mAstFlow)) Map
  PoolId
  ((CashFlowFrame, CashFlowFrame),
   Maybe [(CashFlowFrame, CashFlowFrame)])
cutOffPoolFlowMap  
              -- deposit cashflow to SPV from external pool cf               
            in 
              do 
                Map String Account
accs <- [CollectionRule]
-> Date
-> Map PoolId PoolCashflow
-> Map String Account
-> Either String (Map String Account)
depositPoolFlow (TestDeal a -> [CollectionRule]
forall a. TestDeal a -> [CollectionRule]
collects TestDeal a
t) Date
d Map PoolId PoolCashflow
collectedFlow Map String Account
accMap -- `debug` ("PoolCollection: deposit >>"++ show d++">>>"++ show collectedFlow++"\n")
                let dAfterDeposit :: TestDeal a
dAfterDeposit = (Date -> TestDeal a -> Map PoolId PoolCashflow -> TestDeal a
forall a.
Asset a =>
Date -> TestDeal a -> Map PoolId PoolCashflow -> TestDeal a
appendCollectedCF Date
d TestDeal a
t Map PoolId PoolCashflow
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
$
	                                          (ASetter (Map PoolId (Pool a)) (Map PoolId (Pool a)) [TsRow] [TsRow]
-> ([TsRow] -> [TsRow])
-> Map PoolId (Pool a)
-> Map PoolId (Pool a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((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)))
-> (([TsRow] -> Identity [TsRow]) -> Pool a -> Identity (Pool a))
-> ASetter
     (Map PoolId (Pool a)) (Map PoolId (Pool a)) [TsRow] [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> Pool a -> Identity (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureScheduleCf ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
 -> Pool a -> Identity (Pool a))
-> (([TsRow] -> Identity [TsRow])
    -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ([TsRow] -> Identity [TsRow])
-> Pool a
-> Identity (Pool a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Identity PoolCashflow)
-> Maybe PoolCashflow -> Identity (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PoolCashflow -> Identity PoolCashflow)
 -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> (([TsRow] -> Identity [TsRow])
    -> PoolCashflow -> Identity PoolCashflow)
-> ([TsRow] -> Identity [TsRow])
-> Maybe PoolCashflow
-> Identity (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Identity CashFlowFrame)
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1 ((CashFlowFrame -> Identity CashFlowFrame)
 -> PoolCashflow -> Identity PoolCashflow)
-> (([TsRow] -> Identity [TsRow])
    -> CashFlowFrame -> Identity CashFlowFrame)
-> ([TsRow] -> Identity [TsRow])
-> PoolCashflow
-> Identity PoolCashflow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Identity [TsRow])
-> CashFlowFrame -> Identity CashFlowFrame
Lens' CashFlowFrame [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) -> PoolType a)
-> Map PoolId (UnderlyingDeal a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ 
				                  (ASetter
  (Map PoolId (UnderlyingDeal a))
  (Map PoolId (UnderlyingDeal a))
  [TsRow]
  [TsRow]
-> ([TsRow] -> [TsRow])
-> Map PoolId (UnderlyingDeal a)
-> Map PoolId (UnderlyingDeal a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((UnderlyingDeal a -> Identity (UnderlyingDeal a))
-> Map PoolId (UnderlyingDeal a)
-> Identity (Map PoolId (UnderlyingDeal a))
Setter
  (Map PoolId (UnderlyingDeal a))
  (Map PoolId (UnderlyingDeal a))
  (UnderlyingDeal a)
  (UnderlyingDeal a)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((UnderlyingDeal a -> Identity (UnderlyingDeal a))
 -> Map PoolId (UnderlyingDeal a)
 -> Identity (Map PoolId (UnderlyingDeal a)))
-> (([TsRow] -> Identity [TsRow])
    -> UnderlyingDeal a -> Identity (UnderlyingDeal a))
-> ASetter
     (Map PoolId (UnderlyingDeal a))
     (Map PoolId (UnderlyingDeal a))
     [TsRow]
     [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CashFlowFrame -> Identity (Maybe CashFlowFrame))
-> UnderlyingDeal a -> Identity (UnderlyingDeal a)
forall a. Asset a => Lens' (UnderlyingDeal a) (Maybe CashFlowFrame)
Lens' (UnderlyingDeal a) (Maybe CashFlowFrame)
uDealFutureScheduleCf ((Maybe CashFlowFrame -> Identity (Maybe CashFlowFrame))
 -> UnderlyingDeal a -> Identity (UnderlyingDeal a))
-> (([TsRow] -> Identity [TsRow])
    -> Maybe CashFlowFrame -> Identity (Maybe CashFlowFrame))
-> ([TsRow] -> Identity [TsRow])
-> UnderlyingDeal a
-> Identity (UnderlyingDeal a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Identity CashFlowFrame)
-> Maybe CashFlowFrame -> Identity (Maybe CashFlowFrame)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CashFlowFrame -> Identity CashFlowFrame)
 -> Maybe CashFlowFrame -> Identity (Maybe CashFlowFrame))
-> (([TsRow] -> Identity [TsRow])
    -> CashFlowFrame -> Identity CashFlowFrame)
-> ([TsRow] -> Identity [TsRow])
-> Maybe CashFlowFrame
-> Identity (Maybe CashFlowFrame)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Identity [TsRow])
-> CashFlowFrame -> Identity CashFlowFrame
Lens' CashFlowFrame [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 (UnderlyingDeal a)
dMap
                let runContext :: RunContext a
runContext = Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId PoolCashflow
outstandingFlow Maybe (Map String (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runTriggers (TestDeal a
dAfterDeposit {pool = newPt},RunContext a
forall {a}. 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 String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     String
     (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 PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run (TestDeal a -> TestDeal a
forall a. TestDeal a -> TestDeal a
increasePoolCollectedPeriod TestDeal a
dRunWithTrigger1 )
                    (RunContext a -> Map PoolId PoolCashflow
forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow RunContext a
rc3) 
                    ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads3) 
                    Maybe [RateAssumption]
rates 
                    Maybe ([Pre], [Pre])
calls 
                    Maybe (Map String (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 PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log 

        RunWaterfall Date
d String
"" -> 
          let
            runContext :: RunContext a
runContext = Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId PoolCashflow
poolFlowMap Maybe (Map String (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runTriggers (TestDeal a
t, RunContext a
forall {a}. 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 [ String -> ResultComponent
WarningMsg (String
" No waterfall distribution found on date "String -> String -> String
forall a. [a] -> [a] -> [a]
++Date -> String
forall a. Show a => a -> String
show Date
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" with waterfall key "String -> String -> String
forall a. [a] -> [a] -> [a]
++ActionWhen -> String
forall a. Show a => a -> String
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 String Bool) -> [Pre] -> Either String Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (Date -> TestDeal a -> Pre -> Either String Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either String 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 -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called String
"Call by triggers before waterfall distribution"]
                                  else 
                                    [Date -> DealStatus -> DealStatus -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called String
"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 String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (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 String (DList ResultComponent)
forall a.
Asset a =>
TestDeal a
-> Date
-> DList ResultComponent
-> Either String (DList ResultComponent)
Rpt.patchFinancialReports TestDeal a
dealAfterCleanUp Date
d DList ResultComponent
newLogWaterfall_
                  (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) String
"Clean Up"]),DList ResultComponent
endingLogs], Map PoolId PoolCashflow
poolFlowMap) -- `debug` ("Called ! "++ show d)
              else
                do
                  (TestDeal a
dAfterWaterfall, RunContext a
rc2, DList ResultComponent
newLogsWaterfall) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate])
-> Date
-> DealCycle
-> Either
     String
     (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 PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run (TestDeal a -> TestDeal a
forall a. TestDeal a -> TestDeal a
increaseBondPaidPeriod TestDeal a
dRunWithTrigger1)
                      (RunContext a -> Map PoolId PoolCashflow
forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow RunContext a
rc3) 
                      ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads2) 
                      Maybe [RateAssumption]
rates 
                      Maybe ([Pre], [Pre])
calls 
                      Maybe (Map String (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 String
wName -> 
          let
            runContext :: RunContext a
runContext = Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId PoolCashflow
poolFlowMap Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates
            waterfallKey :: ActionWhen
waterfallKey = String -> ActionWhen
W.CustomWaterfall String
wName
          in 
            do
              [Action]
waterfallToExe <- String -> Maybe [Action] -> Either String [Action]
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither
                                  (String
"No waterfall distribution found on date "String -> String -> String
forall a. [a] -> [a] -> [a]
++Date -> String
forall a. Show a => a -> String
show Date
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" with waterfall key "String -> String -> String
forall a. [a] -> [a] -> [a]
++ActionWhen -> String
forall a. Show a => a -> String
show ActionWhen
waterfallKey) (Maybe [Action] -> Either String [Action])
-> Maybe [Action] -> Either String [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 =[ String -> ResultComponent
WarningMsg (String
" No waterfall distribution found on date "String -> String -> String
forall a. [a] -> [a] -> [a]
++Date -> String
forall a. Show a => a -> String
show Date
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" with waterfall key "String -> String -> String
forall a. [a] -> [a] -> [a]
++ActionWhen -> String
forall a. Show a => a -> String
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 String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t,RunContext a
forall {a}. RunContext a
runContext,DList ResultComponent
log) [Action]
waterfallToExe -- `debug` (show d ++ " running action"++ show waterfallToExe)
              TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
dAfterWaterfall (RunContext a -> Map PoolId PoolCashflow
forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow RunContext a
rc2) ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (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 String
accName ->
          let 
            newAcc :: Map String Account
newAcc = (Account -> Account)
-> String -> Map String Account -> Map String Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Account -> Account
A.depositInt Date
d) String
accName Map String Account
accMap
          in 
            TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run (TestDeal a
t {accounts = newAcc}) Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

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

        ResetLiqProvider Date
d String
liqName -> 
          case TestDeal a -> Maybe (Map String LiqFacility)
forall a. TestDeal a -> Maybe (Map String LiqFacility)
liqProvider TestDeal a
t of 
            Maybe (Map String LiqFacility)
Nothing -> TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
            (Just Map String LiqFacility
mLiqProvider) 
              -> let -- update credit 
                   newLiqMap :: Map String LiqFacility
newLiqMap = (LiqFacility -> LiqFacility)
-> String -> Map String LiqFacility -> Map String 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) String
liqName Map String LiqFacility
mLiqProvider
                 in
                   TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run (TestDeal a
t{liqProvider = Just newLiqMap}) Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        ResetLiqProviderRate Date
d String
liqName -> 
          case TestDeal a -> Maybe (Map String LiqFacility)
forall a. TestDeal a -> Maybe (Map String LiqFacility)
liqProvider TestDeal a
t of 
            Maybe (Map String LiqFacility)
Nothing -> TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
            (Just Map String LiqFacility
mLiqProvider) 
              -> let -- update rate 
                   newLiqMap :: Map String LiqFacility
newLiqMap = (LiqFacility -> LiqFacility)
-> String -> Map String LiqFacility -> Map String 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)) String
liqName Map String LiqFacility
mLiqProvider
                 in
                   TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run (TestDeal a
t{liqProvider = Just newLiqMap}) Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (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 PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId PoolCashflow
poolFlowMap Maybe (Map String (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 String DealStatus
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return DealStatus
st
                         DealStatus
_ -> String -> Either String DealStatus
forall a b. a -> Either a b
Left (String -> Either String DealStatus)
-> String -> Either String DealStatus
forall a b. (a -> b) -> a -> b
$ String
"DealClosed action is not in PreClosing status but got"String -> String -> String
forall a. [a] -> [a] -> [a]
++ DealStatus -> String
forall a. Show a => a -> String
show DealStatus
dStatus
              (TestDeal a
newDeal, RunContext a
newRc, DList ResultComponent
newLog) <- ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t, RunContext a
forall {a}. RunContext a
rc, DList ResultComponent
log) [Action]
w  -- `debug` ("ClosingDay Action:"++show w)
              TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
newDeal{status=newSt} (RunContext a -> Map PoolId PoolCashflow
forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow RunContext a
newRc) ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (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 -> String -> ResultComponent
DealStatusChangeTo Date
d (DealStatus -> DealStatus
PreClosing DealStatus
newSt) DealStatus
newSt String
"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 PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run (TestDeal a
t{status=s}) Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

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

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

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

        InspectDS Date
d [DealStats]
dss -> 
          do
            [ResultComponent]
newlog <- TestDeal a
-> Date -> [DealStats] -> Either String [ResultComponent]
forall a.
Asset a =>
TestDeal a
-> Date -> [DealStats] -> Either String [ResultComponent]
inspectListVars TestDeal a
t Date
d [DealStats]
dss 
            TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      String
      (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
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 String
bn  -> 
          let 
            rateList :: [RateAssumption]
rateList = [RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
rates
            bnd :: Bond
bnd = Map String Bond
bndMap Map String Bond -> String -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! String
bn
          in 
            do 
              Bond
newBnd <- TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either String Bond
forall a.
Asset a =>
TestDeal a
-> Date -> [RateAssumption] -> Bond -> Either String Bond
setBondNewRate TestDeal a
t Date
d [RateAssumption]
rateList Bond
bnd 
              TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t{bonds = Map.fromList [(bn,newBnd)] <> bndMap} Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        
        StepUpBondRate Date
d String
bn -> 
          let 
            bnd :: Bond
bnd = Map String Bond
bndMap Map String Bond -> String -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! String
bn -- `debug` ("StepUpBondRate--------------"++ show bn)
          in 
            do 
              Map String Bond
newBndMap <- (Bond -> Either String Bond)
-> String -> Map String Bond -> Either String (Map String Bond)
forall k (m :: * -> *) a.
(Ord k, Applicative m) =>
(a -> m a) -> k -> Map k a -> m (Map k a)
adjustM (Date -> [RateAssumption] -> Bond -> Either String Bond
setBondStepUpRate Date
d ([RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
rates)) String
bn Map String Bond
bndMap
              TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t{bonds = newBndMap } Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        
        ResetAccRate Date
d String
accName -> 
          do
            Map String Account
newAccMap <- (Account -> Either String Account)
-> String
-> Map String Account
-> Either String (Map String 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
_ String
_ (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 String 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 String Account
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Account
accWithNewInt { A.accInterest = Just (A.InvestmentAccount idx spd dp dp1 lastDay newRate)})
                          String
accName Map String Account
accMap
            TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t{accounts = newAccMap} Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (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 String BalanceSheetReport
forall a.
Asset a =>
TestDeal a -> Date -> Either String 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 PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      String
      (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
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 String
n -> 
          let 
            triggerFired :: Map DealCycle (Map String Trigger)
triggerFired = case Maybe (Map DealCycle (Map String Trigger))
mTrgMap of 
                               Maybe (Map DealCycle (Map String Trigger))
Nothing -> String -> Map DealCycle (Map String Trigger)
forall a. HasCallStack => String -> a
error String
"trigger is empty for override" 
                               Just Map DealCycle (Map String Trigger)
tm -> (Map String Trigger -> Map String Trigger)
-> DealCycle
-> Map DealCycle (Map String Trigger)
-> Map DealCycle (Map String Trigger)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Trigger -> Trigger)
-> String -> Map String Trigger -> Map String 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) String
n) DealCycle
cyc Map DealCycle (Map String Trigger)
tm
            triggerEffects :: Maybe TriggerEffect
triggerEffects = do
                                Map DealCycle (Map String Trigger)
tm <- Maybe (Map DealCycle (Map String Trigger))
mTrgMap
                                Map String Trigger
cycM <- DealCycle
-> Map DealCycle (Map String Trigger) -> Maybe (Map String Trigger)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DealCycle
cyc Map DealCycle (Map String Trigger)
tm
                                Trigger
trg <- String -> Map String Trigger -> Maybe Trigger
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n Map String 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 PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId PoolCashflow
poolFlowMap Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump Maybe [RateAssumption]
rates
          in 
            do 
              (TestDeal a
newT, rc :: RunContext a
rc@(RunContext Map PoolId PoolCashflow
newPool Maybe (Map String (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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, RunContext a
forall {a}. 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
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
forall a.
Asset a =>
(TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
-> Date
-> TriggerEffect
-> Either
     String
     (TestDeal a, RunContext a, [ActionOnDate], DList ResultComponent)
runEffects (TestDeal a
t, RunContext a
forall {a}. 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 -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
oldStatus DealStatus
newStatus String
"by Manual fireTrigger" |  DealStatus
oldStatus DealStatus -> DealStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= DealStatus
newStatus] 
              TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
newT {triggers = Just triggerFired} Map PoolId PoolCashflow
newPool ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      String
      (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
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 CashFlowFrame
schedulePoolFlowMap = case PoolType a
pt of 
				      MultiPool Map PoolId (Pool a)
pMap -> (Pool a -> CashFlowFrame)
-> Map PoolId (Pool a) -> Map PoolId CashFlowFrame
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Getting CashFlowFrame (Pool a) CashFlowFrame
-> Pool a -> CashFlowFrame
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
-> Pool a -> Const CashFlowFrame (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureScheduleCf((Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
 -> Pool a -> Const CashFlowFrame (Pool a))
-> ((CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
    -> Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
-> Getting CashFlowFrame (Pool a) CashFlowFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PoolCashflow -> Const CashFlowFrame PoolCashflow)
-> Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just((PoolCashflow -> Const CashFlowFrame PoolCashflow)
 -> Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
-> ((CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
    -> PoolCashflow -> Const CashFlowFrame PoolCashflow)
-> (CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
-> Maybe PoolCashflow
-> Const CashFlowFrame (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
-> PoolCashflow -> Const CashFlowFrame PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1) ) Map PoolId (Pool a)
pMap 
				      ResecDeal Map PoolId (UnderlyingDeal a)
uDealMap -> (UnderlyingDeal a -> CashFlowFrame)
-> Map PoolId (UnderlyingDeal a) -> Map PoolId CashFlowFrame
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Getting CashFlowFrame (UnderlyingDeal a) CashFlowFrame
-> UnderlyingDeal a -> CashFlowFrame
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Maybe CashFlowFrame -> Const CashFlowFrame (Maybe CashFlowFrame))
-> UnderlyingDeal a -> Const CashFlowFrame (UnderlyingDeal a)
forall a. Asset a => Lens' (UnderlyingDeal a) (Maybe CashFlowFrame)
Lens' (UnderlyingDeal a) (Maybe CashFlowFrame)
uDealFutureScheduleCf ((Maybe CashFlowFrame -> Const CashFlowFrame (Maybe CashFlowFrame))
 -> UnderlyingDeal a -> Const CashFlowFrame (UnderlyingDeal a))
-> ((CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
    -> Maybe CashFlowFrame
    -> Const CashFlowFrame (Maybe CashFlowFrame))
-> Getting CashFlowFrame (UnderlyingDeal a) CashFlowFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
-> Maybe CashFlowFrame -> Const CashFlowFrame (Maybe CashFlowFrame)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just)) Map PoolId (UnderlyingDeal a)
uDealMap
            in 
              do 
                Rational
factor <- (Rational -> Rational -> Rational)
-> Either String Rational
-> Either String Rational
-> Either String Rational
forall a b c.
(a -> b -> c)
-> Either String a -> Either String b -> Either String c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
                            Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/)
                            (TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t Date
d (Maybe [PoolId] -> DealStats
FutureCurrentPoolBegBalance Maybe [PoolId]
forall a. Maybe a
Nothing)) 
                            (TestDeal a -> Date -> DealStats -> Either String Rational
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either String Rational
queryCompound TestDeal a
t Date
d (Maybe [PoolId] -> DealStats
FutureCurrentSchedulePoolBegBalance Maybe [PoolId]
forall a. Maybe a
Nothing))
                let reduceCfs :: Map PoolId (CashFlowFrame, Maybe a)
reduceCfs = (CashFlowFrame -> (CashFlowFrame, Maybe a))
-> Map PoolId CashFlowFrame -> Map PoolId (CashFlowFrame, Maybe a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\CashFlowFrame
f -> ((([TsRow] -> Identity [TsRow])
 -> CashFlowFrame -> Identity CashFlowFrame)
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ([TsRow] -> Identity [TsRow])
-> CashFlowFrame -> Identity CashFlowFrame
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn (\[TsRow]
xs -> Rational -> TsRow -> TsRow
CF.scaleTsRow Rational
factor (TsRow -> TsRow) -> [TsRow] -> [TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
xs) CashFlowFrame
f, Maybe a
forall a. Maybe a
Nothing ) ) Map PoolId CashFlowFrame
schedulePoolFlowMap -- need to apply with factor and trucate with date
                (TestDeal a
runDealWithSchedule,DList ResultComponent
_,Map PoolId PoolCashflow
_) <- TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
forall {a}. Map PoolId (CashFlowFrame, Maybe a)
reduceCfs ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
                let bondWal :: Map String Rational
bondWal = (Bond -> Rational) -> Map String Bond -> Map String Rational
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Date -> Bond -> Rational
L.calcWalBond Date
d) (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
runDealWithSchedule) -- `debug` ("Bond schedule flow"++ show (bonds runDealWithSchedule))
                let bondSprd :: Map String IRate
bondSprd = (Rational -> IRate) -> Map String Rational -> Map String IRate
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 
                                 (\Rational
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 (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>)))))
                                 Map String Rational
bondWal 
                let bondPricingCurve :: Map String Ts
bondPricingCurve = (IRate -> Ts) -> Map String IRate -> Map String 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 String IRate
bondSprd 
                let bondPricingResult :: Map String PriceResult
bondPricingResult = (String -> Bond -> Ts -> PriceResult)
-> Map String Bond -> Map String Ts -> Map String PriceResult
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey (\String
k Bond
v1 Ts
v2 -> Date -> Ts -> Bond -> PriceResult
L.priceBond Date
d Ts
v2 Bond
v1) (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
runDealWithSchedule) Map String Ts
bondPricingCurve 
                let depositBondFlow :: Map String Bond
depositBondFlow = (Bond -> PriceResult -> Bond)
-> Map String Bond -> Map String PriceResult -> Map String 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 String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
t)
                                        Map String PriceResult
bondPricingResult
                TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t {bonds = depositBondFlow, status = Ended (Just d)} Map PoolId PoolCashflow
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 String (RevolvingPool, ApplyAssumptionType))
rAssump (DList ResultComponent
 -> Either
      String
      (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
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 -> String -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) String
"MakeWhole call")
        
        FundBond Date
d Maybe Pre
Nothing String
bName String
accName Balance
fundAmt ->
          let 
            newAcc :: Map String Account
newAcc = (Account -> Account)
-> String -> Map String Account -> Map String 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 (String -> Balance -> TxnComment
FundWith String
bName Balance
fundAmt)) String
accName Map String 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 String Bond
bndMap Map String Bond -> String -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! String
bName
              TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t{accounts = newAcc, bonds = Map.insert bName bndFunded bndMap}
                  Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

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

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

                             let issuanceProceeds :: Balance
issuanceProceeds = Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational Rational
newBalance
                             let newAcc :: Map String Account
newAcc = (Account -> Account)
-> String -> Map String Account -> Map String 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 (String -> TxnComment
IssuanceProceeds String
newBndName))
                                                     String
accName
                                                     Map String Account
accMap
                             TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t{bonds = newBonds, accounts = newAcc} Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
        RefiBondRate Date
d String
accName String
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
_ String
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 String Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either String Bond
calcDueInt TestDeal a
t Date
d (Bond -> Either String Bond) -> Bond -> Either String Bond
forall a b. (a -> b) -> a -> b
$ Map String Bond
bndMap Map String Bond -> String -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! String
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 [String
bName]) (Map String Account
accMap Map String Account -> String -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! String
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 String Account
newAccMap = String -> Account -> Map String Account -> Map String Account
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
accName Account
newAcc Map String Account
accMap
               let newBndMap :: Map String Bond
newBndMap = String -> Bond -> Map String Bond -> Map String Bond
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
bName (Bond
newBnd {L.bndRate = newRate, L.bndDueIntDate = Just d ,L.bndLastIntPay = Just d}) Map String 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 PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t{bonds = newBndMap, accounts = newAccMap} Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
newAds) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log
           
        RefiBond Date
d String
accName Bond
bnd -> String
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a b. a -> Either a b
Left String
"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 String Bool] -> Either String [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 String Bool] -> Either String [Bool])
-> [Either String Bool] -> Either String [Bool]
forall a b. (a -> b) -> a -> b
$ [ (Date -> TestDeal a -> Pre -> Either String Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either String Bool
testPre Date
d TestDeal a
t Pre
pre) | 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 PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
forall a.
Map PoolId PoolCashflow
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> Maybe [RateAssumption]
-> RunContext a
RunContext Map PoolId PoolCashflow
poolFlowMap Maybe (Map String (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 -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called String
"by Date-Based Call"]
                                 else 
                                   [ResultComponent] -> DList ResultComponent
forall a. [a] -> DList a
DL.fromList [Date -> DealStatus -> DealStatus -> String -> ResultComponent
DealStatusChangeTo Date
d DealStatus
dStatus DealStatus
Called String
"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 String (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either String (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 String (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either String (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t, RunContext a
forall {a}. RunContext a
runContext, DList ResultComponent
log) [Action]
cleanUpActions
                       DList ResultComponent
endingLogs <- TestDeal a
-> Date
-> DList ResultComponent
-> Either String (DList ResultComponent)
forall a.
Asset a =>
TestDeal a
-> Date
-> DList ResultComponent
-> Either String (DList ResultComponent)
Rpt.patchFinancialReports TestDeal a
dealAfterCleanUp Date
d DList ResultComponent
newLogWaterfall_
                       (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) String
"Clean Up"), Map PoolId PoolCashflow
poolFlowMap) -- `debug` ("Called ! "++ show d)
                Bool
_ -> TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log

        StopRunTest Date
d [Pre]
pres -> 
	  do
            [Bool]
flags::[Bool] <- [Either String Bool] -> Either String [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 String Bool] -> Either String [Bool])
-> [Either String Bool] -> Either String [Bool]
forall a b. (a -> b) -> a -> b
$ [ (Date -> TestDeal a -> Pre -> Either String Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either String Bool
testPre Date
d TestDeal a
t Pre
pre) | 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 PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String 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 -> String -> ResultComponent
EndRun (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
d) (String
"Stop Run Test by:"String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Pre, Bool)] -> String
forall a. Show a => a -> String
show ([Pre] -> [Bool] -> [(Pre, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Pre]
pres [Bool]
flags))), Map PoolId PoolCashflow
poolFlowMap)
	      Bool
_ -> TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a.
Asset a =>
TestDeal a
-> Map PoolId PoolCashflow
-> Maybe [ActionOnDate]
-> Maybe [RateAssumption]
-> Maybe ([Pre], [Pre])
-> Maybe (Map String (RevolvingPool, ApplyAssumptionType))
-> DList ResultComponent
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
run TestDeal a
t Map PoolId PoolCashflow
poolFlowMap ([ActionOnDate] -> Maybe [ActionOnDate]
forall a. a -> Maybe a
Just [ActionOnDate]
ads) Maybe [RateAssumption]
rates Maybe ([Pre], [Pre])
calls Maybe (Map String (RevolvingPool, ApplyAssumptionType))
rAssump DList ResultComponent
log


        ActionOnDate
_ -> String
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a b. a -> Either a b
Left (String
 -> Either
      String
      (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow))
-> String
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a b. (a -> b) -> a -> b
$ String
"Failed to match action on Date"String -> String -> String
forall a. [a] -> [a] -> [a]
++ ActionOnDate -> String
forall a. Show a => a -> String
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
$ (PoolCashflow -> Int) -> Map PoolId PoolCashflow -> Map PoolId Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(CashFlowFrame
x,Maybe [CashFlowFrame]
_) -> CashFlowFrame -> Int
CF.sizeCashFlowFrame CashFlowFrame
x ) Map PoolId PoolCashflow
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
$ (PoolCashflow -> Bool)
-> Map PoolId PoolCashflow -> Map PoolId Bool
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(CashFlowFrame
pcf,Maybe [CashFlowFrame]
_) -> (TsRow -> Bool) -> [TsRow] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TsRow -> Bool
CF.isEmptyRow2 ((([TsRow] -> Const [TsRow] [TsRow])
 -> CashFlowFrame -> Const [TsRow] CashFlowFrame)
-> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ([TsRow] -> Const [TsRow] [TsRow])
-> CashFlowFrame -> Const [TsRow] CashFlowFrame
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
pcf)) Map PoolId PoolCashflow
poolFlowMap

-- run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.PoolCashflow -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe ([Pre],[Pre])
--         -> Maybe (Map.Map String (RevolvingPool,AP.ApplyAssumptionType)) -> DL.DList ResultComponent 
--         -> Either String (TestDeal a, DL.DList ResultComponent, Map.Map PoolId CF.PoolCashflow)

-- run t empty Nothing Nothing Nothing Nothing log
--   = do
--       (t, ads, pcf, unStressPcf) <- getInits S.empty t Nothing Nothing 
--       run t pcf (Just ads) Nothing Nothing Nothing log  -- `debug` ("Init Done >>Last Action#"++show (length ads)++"F/L"++show (head ads)++show (last ads))

run TestDeal a
t Map PoolId PoolCashflow
empty Maybe [ActionOnDate]
_ Maybe [RateAssumption]
_ Maybe ([Pre], [Pre])
_ Maybe (Map String (RevolvingPool, ApplyAssumptionType))
_ DList ResultComponent
log = (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
-> Either
     String (TestDeal a, DList ResultComponent, Map PoolId PoolCashflow)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, DList ResultComponent
log ,Map PoolId PoolCashflow
empty) -- `debug` ("End with pool CF is []")