{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}

module Pool (Pool(..),aggPool
       ,getIssuanceField
       ,poolFutureCf,poolIssuanceStat
       ,poolFutureScheduleCf
       ,poolBegStats,calcLiquidationAmount,pricingPoolFlow
       ,futureScheduleCfLens,futureCfLens, poolFutureCf
       ,runPool
) where


import Lib (Period(..)
           ,Ts(..),periodRateFromAnnualRate,toDate
           ,getIntervalDays,zipWith9,mkTs,periodsBetween
           ,mkRateTs,daysBetween, )

import Control.Parallel.Strategies
import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals)
import qualified Assumptions as A
import qualified Analytics as AN
import qualified AssetClass.AssetBase as ACM 
import AssetClass.Mortgage
import AssetClass.AssetCashflow
import Asset (Asset(..))
import qualified Data.Map as Map

import Data.Ratio
import qualified Data.Set as S
import Data.List
import Data.Aeson hiding (json)
import Language.Haskell.TH
import GHC.Generics
import Data.Aeson.TH
import Data.Aeson.Types
import Types hiding (Current)

import Data.Maybe
import Control.Lens
import Control.Lens.TH
import Assumptions (ApplyAssumptionType)

import Util
import Cashflow (CashFlowFrame)
import qualified Stmt as CF
import Stmt
import Debug.Trace
debug :: c -> String -> c
debug = (String -> c -> c) -> c -> String -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> c -> c
forall a. String -> a -> a
trace


data Pool a = Pool {forall a. Pool a -> [a]
assets :: [a]                                           -- ^ a list of assets in the pool
                   ,forall a. Pool a -> Maybe PoolCashflow
futureCf :: Maybe CF.PoolCashflow                       -- ^ collected cashflow from the assets in the pool
                   ,forall a. Pool a -> Maybe PoolCashflow
futureScheduleCf :: Maybe CF.PoolCashflow               -- ^ collected un-stressed cashflow
                   ,forall a. Pool a -> Date
asOfDate :: Date                                        -- ^ include cashflow after this date 
                   ,forall a. Pool a -> Maybe (Map CutoffFields BeginBalance)
issuanceStat :: Maybe (Map.Map CutoffFields Balance)    -- ^ cutoff balance of pool
                   ,forall a. Pool a -> Maybe DatePattern
extendPeriods :: Maybe DatePattern                      -- ^ dates for extend pool collection
                   } deriving (Int -> Pool a -> ShowS
[Pool a] -> ShowS
Pool a -> String
(Int -> Pool a -> ShowS)
-> (Pool a -> String) -> ([Pool a] -> ShowS) -> Show (Pool a)
forall a. Show a => Int -> Pool a -> ShowS
forall a. Show a => [Pool a] -> ShowS
forall a. Show a => Pool a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Pool a -> ShowS
showsPrec :: Int -> Pool a -> ShowS
$cshow :: forall a. Show a => Pool a -> String
show :: Pool a -> String
$cshowList :: forall a. Show a => [Pool a] -> ShowS
showList :: [Pool a] -> ShowS
Show, (forall x. Pool a -> Rep (Pool a) x)
-> (forall x. Rep (Pool a) x -> Pool a) -> Generic (Pool a)
forall x. Rep (Pool a) x -> Pool a
forall x. Pool a -> Rep (Pool a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Pool a) x -> Pool a
forall a x. Pool a -> Rep (Pool a) x
$cfrom :: forall a x. Pool a -> Rep (Pool a) x
from :: forall x. Pool a -> Rep (Pool a) x
$cto :: forall a x. Rep (Pool a) x -> Pool a
to :: forall x. Rep (Pool a) x -> Pool a
Generic, Eq (Pool a)
Eq (Pool a) =>
(Pool a -> Pool a -> Ordering)
-> (Pool a -> Pool a -> Bool)
-> (Pool a -> Pool a -> Bool)
-> (Pool a -> Pool a -> Bool)
-> (Pool a -> Pool a -> Bool)
-> (Pool a -> Pool a -> Pool a)
-> (Pool a -> Pool a -> Pool a)
-> Ord (Pool a)
Pool a -> Pool a -> Bool
Pool a -> Pool a -> Ordering
Pool a -> Pool a -> Pool a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Pool a)
forall a. Ord a => Pool a -> Pool a -> Bool
forall a. Ord a => Pool a -> Pool a -> Ordering
forall a. Ord a => Pool a -> Pool a -> Pool a
$ccompare :: forall a. Ord a => Pool a -> Pool a -> Ordering
compare :: Pool a -> Pool a -> Ordering
$c< :: forall a. Ord a => Pool a -> Pool a -> Bool
< :: Pool a -> Pool a -> Bool
$c<= :: forall a. Ord a => Pool a -> Pool a -> Bool
<= :: Pool a -> Pool a -> Bool
$c> :: forall a. Ord a => Pool a -> Pool a -> Bool
> :: Pool a -> Pool a -> Bool
$c>= :: forall a. Ord a => Pool a -> Pool a -> Bool
>= :: Pool a -> Pool a -> Bool
$cmax :: forall a. Ord a => Pool a -> Pool a -> Pool a
max :: Pool a -> Pool a -> Pool a
$cmin :: forall a. Ord a => Pool a -> Pool a -> Pool a
min :: Pool a -> Pool a -> Pool a
Ord, Pool a -> Pool a -> Bool
(Pool a -> Pool a -> Bool)
-> (Pool a -> Pool a -> Bool) -> Eq (Pool a)
forall a. Eq a => Pool a -> Pool a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Pool a -> Pool a -> Bool
== :: Pool a -> Pool a -> Bool
$c/= :: forall a. Eq a => Pool a -> Pool a -> Bool
/= :: Pool a -> Pool a -> Bool
Eq)

makeLensesFor [("futureCf","futureCfLens"),("futureScheduleCf","futureScheduleCfLens")] ''Pool

poolFutureCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow)
poolFutureCf :: forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
poolFutureCf = (Pool a -> Maybe PoolCashflow)
-> (Pool a -> Maybe PoolCashflow -> Pool a)
-> Lens (Pool a) (Pool a) (Maybe PoolCashflow) (Maybe PoolCashflow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Pool a -> Maybe PoolCashflow
forall a. Pool a -> Maybe PoolCashflow
getter Pool a -> Maybe PoolCashflow -> Pool a
forall {a}. Pool a -> Maybe PoolCashflow -> Pool a
setter 
  where 
    getter :: Pool a -> Maybe PoolCashflow
getter = Pool a -> Maybe PoolCashflow
forall a. Pool a -> Maybe PoolCashflow
futureCf
    setter :: Pool a -> Maybe PoolCashflow -> Pool a
setter Pool a
p Maybe PoolCashflow
mNewCf = Pool a
p {futureCf = mNewCf}

poolFutureScheduleCf :: Asset a => Lens' (Pool a) (Maybe CF.PoolCashflow)
poolFutureScheduleCf :: forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
poolFutureScheduleCf = (Pool a -> Maybe PoolCashflow)
-> (Pool a -> Maybe PoolCashflow -> Pool a)
-> Lens (Pool a) (Pool a) (Maybe PoolCashflow) (Maybe PoolCashflow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Pool a -> Maybe PoolCashflow
forall a. Pool a -> Maybe PoolCashflow
getter Pool a -> Maybe PoolCashflow -> Pool a
forall {a}. Pool a -> Maybe PoolCashflow -> Pool a
setter
  where 
    getter :: Pool a -> Maybe PoolCashflow
getter = Pool a -> Maybe PoolCashflow
forall a. Pool a -> Maybe PoolCashflow
futureScheduleCf
    setter :: Pool a -> Maybe PoolCashflow -> Pool a
setter Pool a
p Maybe PoolCashflow
mNewCf = Pool a
p {futureScheduleCf = mNewCf}

poolIssuanceStat :: Asset a => Lens' (Pool a) (Map.Map CutoffFields Balance)
poolIssuanceStat :: forall a. Asset a => Lens' (Pool a) (Map CutoffFields BeginBalance)
poolIssuanceStat = (Pool a -> Map CutoffFields BeginBalance)
-> (Pool a -> Map CutoffFields BeginBalance -> Pool a)
-> Lens
     (Pool a)
     (Pool a)
     (Map CutoffFields BeginBalance)
     (Map CutoffFields BeginBalance)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Pool a -> Map CutoffFields BeginBalance
forall {a}. Pool a -> Map CutoffFields BeginBalance
getter Pool a -> Map CutoffFields BeginBalance -> Pool a
forall {a}. Pool a -> Map CutoffFields BeginBalance -> Pool a
setter
  where 
    getter :: Pool a -> Map CutoffFields BeginBalance
getter Pool a
p =  Map CutoffFields BeginBalance
-> Maybe (Map CutoffFields BeginBalance)
-> Map CutoffFields BeginBalance
forall a. a -> Maybe a -> a
fromMaybe Map CutoffFields BeginBalance
forall k a. Map k a
Map.empty (Maybe (Map CutoffFields BeginBalance)
 -> Map CutoffFields BeginBalance)
-> Maybe (Map CutoffFields BeginBalance)
-> Map CutoffFields BeginBalance
forall a b. (a -> b) -> a -> b
$ Pool a -> Maybe (Map CutoffFields BeginBalance)
forall a. Pool a -> Maybe (Map CutoffFields BeginBalance)
issuanceStat Pool a
p
    setter :: Pool a -> Map CutoffFields BeginBalance -> Pool a
setter Pool a
p Map CutoffFields BeginBalance
m = case Pool a -> Maybe (Map CutoffFields BeginBalance)
forall a. Pool a -> Maybe (Map CutoffFields BeginBalance)
issuanceStat Pool a
p of
                    Maybe (Map CutoffFields BeginBalance)
Nothing -> Pool a
p {issuanceStat = Just m}
                    Just Map CutoffFields BeginBalance
_ -> Pool a
p {issuanceStat = Just m}


-- | get stats of pool 
getIssuanceField :: Pool a -> CutoffFields -> Either String Balance
getIssuanceField :: forall a. Pool a -> CutoffFields -> Either String BeginBalance
getIssuanceField p :: Pool a
p@Pool{issuanceStat :: forall a. Pool a -> Maybe (Map CutoffFields BeginBalance)
issuanceStat = Just Map CutoffFields BeginBalance
m} CutoffFields
s
  = case CutoffFields -> Map CutoffFields BeginBalance -> Maybe BeginBalance
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CutoffFields
s Map CutoffFields BeginBalance
m of
      Just BeginBalance
r -> BeginBalance -> Either String BeginBalance
forall a b. b -> Either a b
Right BeginBalance
r
      Maybe BeginBalance
Nothing -> String -> Either String BeginBalance
forall a b. a -> Either a b
Left (String -> Either String BeginBalance)
-> String -> Either String BeginBalance
forall a b. (a -> b) -> a -> b
$ String
"Faile dto find field "String -> ShowS
forall a. [a] -> [a] -> [a]
++ CutoffFields -> String
forall a. Show a => a -> String
show CutoffFields
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"in pool issuance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map CutoffFields BeginBalance -> String
forall a. Show a => a -> String
show Map CutoffFields BeginBalance
m
getIssuanceField Pool{issuanceStat :: forall a. Pool a -> Maybe (Map CutoffFields BeginBalance)
issuanceStat = Maybe (Map CutoffFields BeginBalance)
Nothing} CutoffFields
s 
  = String -> Either String BeginBalance
forall a b. a -> Either a b
Left (String -> Either String BeginBalance)
-> String -> Either String BeginBalance
forall a b. (a -> b) -> a -> b
$ String
"There is no pool stats to lookup:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CutoffFields -> String
forall a. Show a => a -> String
show CutoffFields
s

poolBegStats :: Pool a -> (Balance,Balance,Balance,Balance,Balance,Balance)
poolBegStats :: forall a.
Pool a
-> (BeginBalance, BeginBalance, BeginBalance, BeginBalance,
    BeginBalance, BeginBalance)
poolBegStats Pool a
p = 
  let 
    m :: Maybe (Map CutoffFields BeginBalance)
m = Pool a -> Maybe (Map CutoffFields BeginBalance)
forall a. Pool a -> Maybe (Map CutoffFields BeginBalance)
issuanceStat Pool a
p
    stats :: (BeginBalance, BeginBalance, BeginBalance, BeginBalance,
 BeginBalance, BeginBalance)
stats = case Maybe (Map CutoffFields BeginBalance)
m of
              Maybe (Map CutoffFields BeginBalance)
Nothing -> (BeginBalance
0,BeginBalance
0,BeginBalance
0,BeginBalance
0,BeginBalance
0,BeginBalance
0)
              Just Map CutoffFields BeginBalance
m -> (BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryPrincipal Map CutoffFields BeginBalance
m
                        ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryPrepayment Map CutoffFields BeginBalance
m
                        ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryDelinquency Map CutoffFields BeginBalance
m
                        ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryDefaults Map CutoffFields BeginBalance
m
                        ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryRecoveries Map CutoffFields BeginBalance
m
                        ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryLoss Map CutoffFields BeginBalance
m)
  in
    (BeginBalance, BeginBalance, BeginBalance, BeginBalance,
 BeginBalance, BeginBalance)
stats


-- | Aggregate all cashflow into a single cashflow frame
-- patch with pool level cumulative defaults/loss etc
aggPool :: Maybe (Map.Map CutoffFields Balance) -> [(CF.CashFlowFrame, Map.Map CutoffFields Balance)] -> (CF.CashFlowFrame, Map.Map CutoffFields Balance)
aggPool :: Maybe (Map CutoffFields BeginBalance)
-> [(CashFlowFrame, Map CutoffFields BeginBalance)]
-> (CashFlowFrame, Map CutoffFields BeginBalance)
aggPool Maybe (Map CutoffFields BeginBalance)
Nothing [] = (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (BeginBalance
0,String -> Date
toDate String
"19000101",Maybe BeginBalance
forall a. Maybe a
Nothing) [],Map CutoffFields BeginBalance
forall k a. Map k a
Map.empty)
aggPool (Just Map CutoffFields BeginBalance
m) [] = (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (BeginBalance
0,String -> Date
toDate String
"19000101",Maybe BeginBalance
forall a. Maybe a
Nothing) [], Map CutoffFields BeginBalance
m)
aggPool Maybe (Map CutoffFields BeginBalance)
mStat [(CashFlowFrame, Map CutoffFields BeginBalance)]
xs 
  = let
      cfs :: [CashFlowFrame]
cfs = (CashFlowFrame, Map CutoffFields BeginBalance) -> CashFlowFrame
forall a b. (a, b) -> a
fst ((CashFlowFrame, Map CutoffFields BeginBalance) -> CashFlowFrame)
-> [(CashFlowFrame, Map CutoffFields BeginBalance)]
-> [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(CashFlowFrame, Map CutoffFields BeginBalance)]
xs
      CF.CashFlowFrame BeginStatus
st [TsRow]
_txns = (CashFlowFrame -> CashFlowFrame -> CashFlowFrame)
-> [CashFlowFrame] -> CashFlowFrame
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 CashFlowFrame -> CashFlowFrame -> CashFlowFrame
CF.combine [CashFlowFrame]
cfs 
      -- total stats with begin stats + stats from each cfs
      stats :: Map CutoffFields BeginBalance
stats = (Map CutoffFields BeginBalance
 -> Map CutoffFields BeginBalance -> Map CutoffFields BeginBalance)
-> [Map CutoffFields BeginBalance] -> Map CutoffFields BeginBalance
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ((BeginBalance -> BeginBalance -> BeginBalance)
-> Map CutoffFields BeginBalance
-> Map CutoffFields BeginBalance
-> Map CutoffFields BeginBalance
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
(+)) ([Map CutoffFields BeginBalance] -> Map CutoffFields BeginBalance)
-> [Map CutoffFields BeginBalance] -> Map CutoffFields BeginBalance
forall a b. (a -> b) -> a -> b
$  Map CutoffFields BeginBalance
-> Maybe (Map CutoffFields BeginBalance)
-> Map CutoffFields BeginBalance
forall a. a -> Maybe a -> a
fromMaybe Map CutoffFields BeginBalance
forall k a. Map k a
Map.empty Maybe (Map CutoffFields BeginBalance)
mStatMap CutoffFields BeginBalance
-> [Map CutoffFields BeginBalance]
-> [Map CutoffFields BeginBalance]
forall a. a -> [a] -> [a]
:((CashFlowFrame, Map CutoffFields BeginBalance)
-> Map CutoffFields BeginBalance
forall a b. (a, b) -> b
snd ((CashFlowFrame, Map CutoffFields BeginBalance)
 -> Map CutoffFields BeginBalance)
-> [(CashFlowFrame, Map CutoffFields BeginBalance)]
-> [Map CutoffFields BeginBalance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(CashFlowFrame, Map CutoffFields BeginBalance)]
xs)
      -- patch cumulative statistics
      cumulativeStatAtCutoff :: (BeginBalance, BeginBalance, BeginBalance, BeginBalance,
 BeginBalance, BeginBalance)
cumulativeStatAtCutoff = case Maybe (Map CutoffFields BeginBalance)
mStat of
                                 Maybe (Map CutoffFields BeginBalance)
Nothing -> (BeginBalance
0,BeginBalance
0,BeginBalance
0,BeginBalance
0,BeginBalance
0,BeginBalance
0)
                                 Just Map CutoffFields BeginBalance
m -> (BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryPrincipal Map CutoffFields BeginBalance
m
                                           ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryPrepayment Map CutoffFields BeginBalance
m
                                           ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryDelinquency Map CutoffFields BeginBalance
m
                                           ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryDefaults Map CutoffFields BeginBalance
m
                                           ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryRecoveries Map CutoffFields BeginBalance
m
                                           ,BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
HistoryLoss Map CutoffFields BeginBalance
m)
      -- (CumPrincipal,CumPrepay,CumDelinq,CumDefault,CumRecovery,CumLoss)
      txns :: [TsRow]
txns = (BeginBalance, BeginBalance, BeginBalance, BeginBalance,
 BeginBalance, BeginBalance)
-> [TsRow] -> [TsRow] -> [TsRow]
CF.patchCumulative (BeginBalance, BeginBalance, BeginBalance, BeginBalance,
 BeginBalance, BeginBalance)
cumulativeStatAtCutoff [] [TsRow]
_txns 
      -- txns = CF.patchCumulativeAtInit (Just cumulativeStatAtCutoff) _txns 
    in
      case CutoffFields -> Map CutoffFields BeginBalance -> Maybe BeginBalance
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CutoffFields
AccruedInterest (Map CutoffFields BeginBalance -> Maybe BeginBalance)
-> Maybe (Map CutoffFields BeginBalance) -> Maybe BeginBalance
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Map CutoffFields BeginBalance)
mStat of
        Maybe BeginBalance
Nothing -> (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st [TsRow]
txns, Map CutoffFields BeginBalance
stats) 
        Just BeginBalance
accruedIntAmt -> (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st (BeginBalance -> [TsRow] -> [TsRow]
CF.clawbackInt BeginBalance
accruedIntAmt [TsRow]
txns), Map CutoffFields BeginBalance
stats)


calcLiquidationAmount :: Asset a => PricingMethod -> Pool a -> Date -> Amount
calcLiquidationAmount :: forall a.
Asset a =>
PricingMethod -> Pool a -> Date -> BeginBalance
calcLiquidationAmount (BalanceFactor Rate
currentFactor Rate
defaultFactor ) Pool a
pool Date
d 
  = case Pool a -> Maybe PoolCashflow
forall a. Pool a -> Maybe PoolCashflow
futureCf Pool a
pool of 
      Just (CF.CashFlowFrame BeginStatus
_ [],Maybe [CashFlowFrame]
_) -> BeginBalance
0
      Just _futureCf :: PoolCashflow
_futureCf@(CF.CashFlowFrame BeginStatus
_ [TsRow]
trs,Maybe [CashFlowFrame]
_) ->
        let 
          earlierTxns :: [TsRow]
earlierTxns = CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Inc DateDirection
Past Date
d [TsRow]
trs
          currentCumulativeDefaultBal :: BeginBalance
currentCumulativeDefaultBal = [BeginBalance] -> BeginBalance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([BeginBalance] -> BeginBalance) -> [BeginBalance] -> BeginBalance
forall a b. (a -> b) -> a -> b
$ (TsRow -> BeginBalance) -> [TsRow] -> [BeginBalance]
forall a b. (a -> b) -> [a] -> [b]
map (\TsRow
x -> TsRow -> BeginBalance
CF.mflowDefault TsRow
x BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
- TsRow -> BeginBalance
CF.mflowRecovery TsRow
x BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
- TsRow -> BeginBalance
CF.mflowLoss TsRow
x) [TsRow]
earlierTxns
        in 
          case [TsRow]
earlierTxns of 
            [] -> BeginBalance
0  -- `debug` ("No pool Inflow")
            [TsRow]
_ -> (BeginBalance -> Rate -> BeginBalance
mulBR (Getting BeginBalance TsRow BeginBalance -> TsRow -> BeginBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BeginBalance TsRow BeginBalance
Lens' TsRow BeginBalance
CF.tsRowBalance ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
earlierTxns)) Rate
currentFactor) BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
+ (BeginBalance -> Rate -> BeginBalance
mulBR BeginBalance
currentCumulativeDefaultBal Rate
defaultFactor)
            -- TODO need to check if missing last row


-- TODO: check futureCf is future CF or not, seems it is collected CF
-- | pricing via future scheduled cashflow( zero risk adjust)
-- | pricing via user define risk adjust cashflow( own assumption)
-- TODO: in revolving buy future schedule cashflow should be updated as well
calcLiquidationAmount (PV IRate
discountRate  Rate
recoveryPct) Pool a
pool Date
d 
  = case Pool a -> Maybe PoolCashflow
forall a. Pool a -> Maybe PoolCashflow
futureCf Pool a
pool of
      Just (CF.CashFlowFrame BeginStatus
_ [],Maybe [CashFlowFrame]
_) -> BeginBalance
0 
      Just (CF.CashFlowFrame BeginStatus
_ [TsRow]
trs,Maybe [CashFlowFrame]
_) ->
          let 
            futureTxns :: [TsRow]
futureTxns = CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Inc DateDirection
Future Date
d [TsRow]
trs -- `debug` (" pv date"++show d++ " with rate"++show discountRate)
            earlierTxns :: [TsRow]
earlierTxns = CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Exc DateDirection
Past Date
d [TsRow]
trs -- `debug` ("Total txn"++show trs)
            pvCf :: BeginBalance
pvCf = [BeginBalance] -> BeginBalance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([BeginBalance] -> BeginBalance) -> [BeginBalance] -> BeginBalance
forall a b. (a -> b) -> a -> b
$ (TsRow -> BeginBalance) -> [TsRow] -> [BeginBalance]
forall a b. (a -> b) -> [a] -> [b]
map (\TsRow
x -> IRate -> Date -> Date -> BeginBalance -> BeginBalance
AN.pv2  IRate
discountRate  Date
d (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate TsRow
x) (TsRow -> BeginBalance
CF.tsTotalCash TsRow
x)) [TsRow]
futureTxns -- `debug` ("FutureTxns: "++show futureTxns)
            
            currentDefaulBal :: BeginBalance
currentDefaulBal = [BeginBalance] -> BeginBalance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([BeginBalance] -> BeginBalance) -> [BeginBalance] -> BeginBalance
forall a b. (a -> b) -> a -> b
$ (TsRow -> BeginBalance) -> [TsRow] -> [BeginBalance]
forall a b. (a -> b) -> [a] -> [b]
map (\TsRow
x -> TsRow -> BeginBalance
CF.mflowDefault TsRow
x BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
- TsRow -> BeginBalance
CF.mflowRecovery TsRow
x BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
- TsRow -> BeginBalance
CF.mflowLoss TsRow
x) [TsRow]
earlierTxns
          in 
            
            BeginBalance
pvCf BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
+ BeginBalance -> Rate -> BeginBalance
mulBR BeginBalance
currentDefaulBal Rate
recoveryPct

-- ^ price a pool with collected cashflow and future cashflow
pricingPoolFlow :: Asset a =>  Date -> Pool a -> CF.PoolCashflow -> PricingMethod -> Amount
pricingPoolFlow :: forall a.
Asset a =>
Date -> Pool a -> PoolCashflow -> PricingMethod -> BeginBalance
pricingPoolFlow Date
d pool :: Pool a
pool@Pool{ futureCf :: forall a. Pool a -> Maybe PoolCashflow
futureCf = Just (CashFlowFrame
mCollectedCf,Maybe [CashFlowFrame]
_), issuanceStat :: forall a. Pool a -> Maybe (Map CutoffFields BeginBalance)
issuanceStat = Maybe (Map CutoffFields BeginBalance)
mStat } (CashFlowFrame
futureCfUncollected,Maybe [CashFlowFrame]
_) PricingMethod
pm 
  = let 
      currentCumulativeDefaultBal :: BeginBalance
currentCumulativeDefaultBal 
        | CashFlowFrame -> Bool
CF.emptyCashFlowFrame  CashFlowFrame
mCollectedCf = BeginBalance
0
        | Bool
otherwise = let 
                        lastTxn :: TsRow
lastTxn = [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last ([TsRow] -> TsRow) -> [TsRow] -> TsRow
forall a b. (a -> b) -> a -> b
$ Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn  (CashFlowFrame -> [TsRow]) -> CashFlowFrame -> [TsRow]
forall a b. (a -> b) -> a -> b
$ CashFlowFrame
mCollectedCf
                      in 
                        BeginBalance -> Maybe BeginBalance -> BeginBalance
forall a. a -> Maybe a -> a
fromMaybe BeginBalance
0 (TsRow -> Maybe BeginBalance
CF.tsCumDefaultBal TsRow
lastTxn) BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
- BeginBalance -> Maybe BeginBalance -> BeginBalance
forall a. a -> Maybe a -> a
fromMaybe BeginBalance
0 (TsRow -> Maybe BeginBalance
CF.tsCumRecoveriesBal TsRow
lastTxn) BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
- BeginBalance -> Maybe BeginBalance -> BeginBalance
forall a. a -> Maybe a -> a
fromMaybe BeginBalance
0 (TsRow -> Maybe BeginBalance
CF.tsCumLossBal TsRow
lastTxn)

      currentPerformingBal :: BeginBalance
currentPerformingBal = case Maybe (Map CutoffFields BeginBalance)
mStat of
              Maybe (Map CutoffFields BeginBalance)
Nothing -> BeginBalance
0
              Just Map CutoffFields BeginBalance
stat -> BeginBalance
-> CutoffFields -> Map CutoffFields BeginBalance -> BeginBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault BeginBalance
0 CutoffFields
RuntimeCurrentPoolBalance Map CutoffFields BeginBalance
stat

    in 
      case PricingMethod
pm of
        BalanceFactor Rate
currentFactor Rate
defaultFactor -> 
          BeginBalance -> Rate -> BeginBalance
mulBR BeginBalance
currentPerformingBal Rate
currentFactor BeginBalance -> BeginBalance -> BeginBalance
forall a. Num a => a -> a -> a
+ BeginBalance -> Rate -> BeginBalance
mulBR BeginBalance
currentCumulativeDefaultBal Rate
defaultFactor

        PvRate IRate
discountRate ->
          let 
            futureTxn :: [TsRow]
futureTxn = Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
futureCfUncollected -- `debug` ("PV with cf"++ show d ++ ">>"++show futureCfUncollected)
            futureCfCash :: [BeginBalance]
futureCfCash = TsRow -> BeginBalance
CF.tsTotalCash (TsRow -> BeginBalance) -> [TsRow] -> [BeginBalance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
futureTxn
            futureDates :: [Date]
futureDates = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsRow -> Date) -> [TsRow] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
futureTxn
          in 
            IRate -> Date -> [Date] -> [BeginBalance] -> BeginBalance
AN.pv21 IRate
discountRate Date
d [Date]
futureDates [BeginBalance]
futureCfCash

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

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

---- By Obligor
runPool (Pool [a]
as Maybe PoolCashflow
_ Maybe PoolCashflow
Nothing Date
asof Maybe (Map CutoffFields BeginBalance)
_ Maybe DatePattern
_) (Just (A.ByObligor [ObligorStrategy]
obligorRules)) Maybe [RateAssumption]
mRates =
  let
    matchAssets :: [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> [ObligorStrategy]
-> [a]
-> Either String [(CashFlowFrame, Map CutoffFields BeginBalance)]
matchAssets []   [ObligorStrategy]
_ [] = [(CashFlowFrame, Map CutoffFields BeginBalance)]
-> Either String [(CashFlowFrame, Map CutoffFields BeginBalance)]
forall a b. b -> Either a b
Right [(BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (BeginBalance
0,Date
epocDate,Maybe BeginBalance
forall a. Maybe a
Nothing) [], Map CutoffFields BeginBalance
forall k a. Map k a
Map.empty)] 
    matchAssets [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
cfs [] [] = [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> Either String [(CashFlowFrame, Map CutoffFields BeginBalance)]
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 (CashFlowFrame, Map CutoffFields BeginBalance)]
cfs
    -- matchAssets cfs [] astList = sequenceA $ cfs ++ ((\x -> (\y -> (y, Map.empty)) <$> (Ast.calcCashflow x asof mRates)) <$> astList)
    matchAssets [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
cfs [] [a]
astList = let
                                    poolCfs :: [Either String CashFlowFrame]
poolCfs = Strategy (Either String CashFlowFrame)
-> (a -> Either String CashFlowFrame)
-> [a]
-> [Either String CashFlowFrame]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Either String CashFlowFrame)
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a -> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
forall a.
Asset a =>
a -> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
calcCashflow a
x Date
asof Maybe [RateAssumption]
mRates) [a]
astList
                                    poolCfs' :: [Either String (CashFlowFrame, Map k a)]
poolCfs' = (\Either String CashFlowFrame
x -> (, Map k a
forall k a. Map k a
Map.empty) (CashFlowFrame -> (CashFlowFrame, Map k a))
-> Either String CashFlowFrame
-> Either String (CashFlowFrame, Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String CashFlowFrame
x) (Either String CashFlowFrame
 -> Either String (CashFlowFrame, Map k a))
-> [Either String CashFlowFrame]
-> [Either String (CashFlowFrame, Map k a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String CashFlowFrame]
poolCfs
                                 in 
                                    [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> Either String [(CashFlowFrame, Map CutoffFields BeginBalance)]
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 (CashFlowFrame, Map CutoffFields BeginBalance)]
 -> Either String [(CashFlowFrame, Map CutoffFields BeginBalance)])
-> [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> Either String [(CashFlowFrame, Map CutoffFields BeginBalance)]
forall a b. (a -> b) -> a -> b
$ [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
cfs [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
forall a. [a] -> [a] -> [a]
++ [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
forall {k} {a}. [Either String (CashFlowFrame, Map k a)]
poolCfs'
    matchAssets [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
cfs (ObligorStrategy
rule:[ObligorStrategy]
rules) [a]
astList = 
      case ObligorStrategy
rule of 
        A.ObligorById [String]
ids AssetPerf
assetPerf 
          -> let 
               idSet :: Set String
idSet = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
ids
               ([a]
matchedAsts,[a]
unMatchedAsts) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition 
                                               (\a
x -> case a -> Maybe String
forall a. Asset a => a -> Maybe String
getObligorId a
x of 
                                                         Just String
oid -> String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
oid Set String
idSet
                                                         Maybe String
Nothing -> Bool
False) 
                                               [a]
astList
               matchedCfs :: [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
matchedCfs = Strategy
  (Either String (CashFlowFrame, Map CutoffFields BeginBalance))
-> (a
    -> Either String (CashFlowFrame, Map CutoffFields BeginBalance))
-> [a]
-> [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy
  (Either String (CashFlowFrame, Map CutoffFields BeginBalance))
forall a. NFData a => Strategy a
rdeepseq (\a
x -> a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either String (CashFlowFrame, Map CutoffFields BeginBalance)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either String (CashFlowFrame, Map CutoffFields BeginBalance)
projCashflow a
x Date
asof AssetPerf
assetPerf Maybe [RateAssumption]
mRates) [a]
matchedAsts 
             in 
               [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> [ObligorStrategy]
-> [a]
-> Either String [(CashFlowFrame, Map CutoffFields BeginBalance)]
matchAssets ([Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
cfs [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
-> [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
forall a. [a] -> [a] -> [a]
++ [Either String (CashFlowFrame, Map CutoffFields BeginBalance)]
matchedCfs) [ObligorStrategy]
rules [a]
unMatchedAsts
        A.ObligorByTag [String]
tags TagMatchRule
tagRule AssetPerf
assetPerf ->
          let 
            obrTags :: Set String
obrTags = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
tags

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

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

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

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



$(deriveJSON defaultOptions ''Pool)