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

module AssetClass.Mortgage  
  (projectMortgageFlow,projectScheduleFlow,updateOriginDate,getOriginInfo
  ,buildARMrates)
  where

import qualified Data.Time as T
import qualified Cashflow as CF 
import qualified Assumptions as A
import Asset as Ast
import Types
import Lib
import Util
import DateUtil
import InterestRate as IR

import qualified Data.Map as Map
import Data.List
import Data.Ratio
import Data.Maybe
import GHC.Generics
import Data.Aeson hiding (json)
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types

import AssetClass.AssetBase
import AssetClass.AssetCashflow
import Debug.Trace
import Assumptions (AssetPerfAssumption(MortgageAssump))
import GHC.Float.RealFracMethods (truncateFloatInteger)
import Cashflow (extendTxns)
import Control.Lens hiding (element)
import Control.Lens.TH
import qualified Data.DList as DL

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

projectMortgageFlow :: (Balance, Balance, Date, Maybe BorrowerNum, AmortPlan, DayCount, IRate, Period, Int) -> (Dates, [DefaultRate],[PrepaymentRate],[IRate],[Int]) -> (DL.DList CF.TsRow, Balance, Balance)
projectMortgageFlow :: (Recovery, Recovery, Date, Maybe Int, AmortPlan, DayCount, IRate,
 Period, Int)
-> (Dates, [Rate], [Rate], [IRate], [Int])
-> (DList TsRow, Recovery, Recovery)
projectMortgageFlow (Recovery
originBal, Recovery
startBal, Date
lastPayDate, Maybe Int
mbn, AmortPlan
pt, DayCount
dc, IRate
startRate, Period
p, Int
oTerms) (Dates
cfDates, [Rate]
defRates, [Rate]
ppyRates, [IRate]
rateVector, [Int]
remainTerms) = 
  let 
    initRow :: TsRow
initRow = Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
lastPayDate Recovery
startBal Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 IRate
startRate Maybe Int
forall a. Maybe a
Nothing Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing
  in 
    ((DList TsRow, Recovery, Recovery)
 -> (Date, Rate, Rate, IRate, Int)
 -> (DList TsRow, Recovery, Recovery))
-> (DList TsRow, Recovery, Recovery)
-> [(Date, Rate, Rate, IRate, Int)]
-> (DList TsRow, Recovery, Recovery)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl 
      (\(DList TsRow
acc, Recovery
begBal, Recovery
lastOriginBal) (Date
pDate, Rate
defRate, Rate
ppyRate, IRate
intRate, Int
rt)
          -> let 
               -- begBal = view CF.tsRowBalance (last acc) 
               -- lastPaidDate = getDate (last acc) -- `debug` ("beg bal"++ show begBal)
               newDefault :: Recovery
newDefault = Recovery -> Rate -> Recovery
mulBR Recovery
begBal Rate
defRate -- `debug` ("new default"++ show defRate++ ">>"++ show begBal)
               newPrepay :: Recovery
newPrepay = Recovery -> Rate -> Recovery
mulBR (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newDefault) Rate
ppyRate
               -- performing balance
               _balAfterPpy :: Recovery
_balAfterPpy = Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newDefault Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrepay -- `debug` ("new ppy "++ show newPrepay ++ "beg bal"++ show (begBal - newDefault) ++ "ppy rate"++ show ppyRate)
               -- performing original balance 
               amortBal :: Recovery
amortBal = Recovery -> Rate -> Recovery
mulBR Recovery
lastOriginBal (Rate -> Recovery) -> Rate -> Recovery
forall a b. (a -> b) -> a -> b
$ (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
defRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
ppyRate)  
               amortTerm :: Int
amortTerm =  case AmortPlan
pt of
                              Balloon Int
aTerm -> Int
aTerm
                              AmortPlan
_ -> Int
oTerms
                
               (Recovery
newInt,Recovery
newPrin) = AmortPlan
-> Recovery
-> IRate
-> Int
-> Int
-> (Recovery, Int)
-> (Recovery, Recovery)
calcAssetPrinInt AmortPlan
pt Recovery
_balAfterPpy (Period -> IRate -> IRate
periodRateFromAnnualRate Period
p IRate
intRate) Int
oTerms Int
rt (Recovery
amortBal, Int
amortTerm) -- `debug` ("using bal for pmt"++ show _balAfterPpy)
               endBal :: Recovery
endBal = Recovery
_balAfterPpy Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrin
               newMbn :: Maybe Int
newMbn = Recovery -> Recovery -> Maybe Int -> Maybe Int
decreaseBorrowerNum Recovery
begBal Recovery
endBal Maybe Int
mbn -- `debug` ("rt in mortgage proj"++ show rt)
             in 
               (DList TsRow -> TsRow -> DList TsRow
forall a. DList a -> a -> DList a
DL.snoc DList TsRow
acc (Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
pDate Recovery
endBal Recovery
newPrin Recovery
newInt Recovery
newPrepay Recovery
newDefault Recovery
0.0 Recovery
0.0 IRate
intRate Maybe Int
newMbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing), Recovery
endBal ,Recovery
amortBal)
      )
      (TsRow -> DList TsRow
forall a. a -> DList a
DL.singleton TsRow
initRow, Recovery
startBal, Recovery
originBal)
      (Dates
-> [Rate]
-> [Rate]
-> [IRate]
-> [Int]
-> [(Date, Rate, Rate, IRate, Int)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 Dates
cfDates [Rate]
defRates [Rate]
ppyRates [IRate]
rateVector [Int]
remainTerms)            
             

projectDelinqMortgageFlow :: ([CF.TsRow],[CF.TsRow]) -> Balance -> Maybe Int -> Date -> [Date] -> [Rate] -> [PrepaymentRate] -> [IRate] -> (Rate,Lag,Rate,Lag,Period,AmortPlan,Int) -> ([Balance],[Balance],[Balance]) -> [CF.TsRow]
projectDelinqMortgageFlow :: ([TsRow], [TsRow])
-> Recovery
-> Maybe Int
-> Date
-> Dates
-> [Rate]
-> [Rate]
-> [IRate]
-> (Rate, Int, Rate, Int, Period, AmortPlan, Int)
-> ([Recovery], [Recovery], [Recovery])
-> [TsRow]
projectDelinqMortgageFlow ([TsRow]
trs,[]) Recovery
_ Maybe Int
_ Date
_ [] [Rate]
_ [Rate]
_ [IRate]
_ (Rate, Int, Rate, Int, Period, AmortPlan, Int)
_ ([Recovery], [Recovery], [Recovery])
_ = [TsRow] -> [TsRow]
CF.dropTailEmptyTxns [TsRow]
trs
projectDelinqMortgageFlow ([TsRow]
trs,[TsRow]
backToPerfs) Recovery
_ Maybe Int
_ Date
_ [] [Rate]
_ [Rate]
_ [IRate]
_ (Rate, Int, Rate, Int, Period, AmortPlan, Int)
_ ([Recovery], [Recovery], [Recovery])
_ = 
  let 
    consolTxn :: [TsRow]
consolTxn = [TsRow] -> [TsRow]
forall a. Ord a => [a] -> [a]
sort [TsRow]
backToPerfs -- `debug` ("Hit pay dates = []")
    ([TsRow]
trsKeep,[TsRow]
trsMerge) = [TsRow] -> Date -> SplitType -> ([TsRow], [TsRow])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [TsRow]
trs (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
backToPerfs)) SplitType
EqToRight
    mergedTrs :: [TsRow]
mergedTrs = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
CF.combineTss [] [TsRow]
trsMerge [TsRow]
consolTxn -- `debug` ("before Merge for delinq Mortgage \n >>> "++ show trs++"Back to Perf"++ show backToPerfs)
  in 
    [TsRow]
trsKeep [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
mergedTrs -- `debug` ("\n MergedTrs \n"++ show mergedTrs)

projectDelinqMortgageFlow ([TsRow]
trs,[TsRow]
backToPerfs) Recovery
beginBal Maybe Int
mbn Date
lastDate (Date
pDate:Dates
pDates) (Rate
delinqRate:[Rate]
delinqRates) (Rate
ppyRate:[Rate]
ppyRates) (IRate
rate:[IRate]
rates) 
                          (Rate
defaultPct,Int
defaultLag,Rate
recoveryRate,Int
recoveryLag,Period
p,AmortPlan
prinType,Int
ot) 
                          (Recovery
dBal:[Recovery]
defaultVec,Recovery
rAmt:[Recovery]
recoveryVec,Recovery
lAmt:[Recovery]
lossVec)
   = ([TsRow], [TsRow])
-> Recovery
-> Maybe Int
-> Date
-> Dates
-> [Rate]
-> [Rate]
-> [IRate]
-> (Rate, Int, Rate, Int, Period, AmortPlan, Int)
-> ([Recovery], [Recovery], [Recovery])
-> [TsRow]
projectDelinqMortgageFlow ([TsRow]
trs[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow
tr],[TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
CF.combineTss [] [TsRow]
backToPerfs [TsRow]
newPerfCfs) Recovery
endingBal Maybe Int
newMbn Date
pDate Dates
pDates [Rate]
delinqRates [Rate]
ppyRates [IRate]
rates 
                   (Rate
defaultPct,Int
defaultLag,Rate
recoveryRate,Int
recoveryLag,Period
p,AmortPlan
prinType,Int
ot) 
                   ([Recovery]
newDefaultVec,[Recovery]
newRecoveryVec,[Recovery]
newLossVec) -- `debug` ("\n calc Date"++ show pDate ++"\n from new perf"++ show backToPerfBal ++"\n new cfs >>> \n"++ show newPerfCfs)
     where 
       remainTerms :: Int
remainTerms = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
pDates Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
defaultLag) 
       delinqBal :: Recovery
delinqBal = Recovery -> Rate -> Recovery
mulBR Recovery
beginBal Rate
delinqRate
       
       defaultBal :: Recovery
defaultBal = Recovery -> Rate -> Recovery
mulBR Recovery
delinqBal Rate
defaultPct 
       recBal :: Recovery
recBal = Recovery -> Rate -> Recovery
mulBR Recovery
defaultBal Rate
recoveryRate
       lossBal :: Recovery
lossBal = Recovery -> Rate -> Recovery
mulBR Recovery
defaultBal (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
recoveryRate)
       
       newDefaultVec :: [Recovery]
newDefaultVec = [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
defaultVec (Int -> Int
forall a. Enum a => a -> a
pred Int
defaultLag) Recovery
defaultBal
       newRecoveryVec :: [Recovery]
newRecoveryVec = [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
recoveryVec (Int -> Int
forall a. Enum a => a -> a
pred Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
defaultLag) Recovery
recBal
       newLossVec :: [Recovery]
newLossVec = [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
lossVec (Int -> Int
forall a. Enum a => a -> a
pred Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
defaultLag) Recovery
lossBal
       
       backToPerfBal :: Recovery
backToPerfBal = Recovery -> Rate -> Recovery
mulBR Recovery
delinqBal (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
defaultPct)
       
       restPerfVector :: [Rate]
restPerfVector = Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Enum a => a -> a
succ ([Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
delinqRates)) Rate
0
       restPerfBal :: [Recovery]
restPerfBal = Rate -> Recovery
forall a. Fractional a => Rate -> a
fromRational (Rate -> Recovery) -> [Rate] -> [Recovery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
restPerfVector -- `debug` ("Dates"++show (pDate:pDates))
       newPerfCfs :: [TsRow]
newPerfCfs = if Recovery
backToPerfBal Recovery -> Recovery -> Bool
forall a. Ord a => a -> a -> Bool
> Recovery
0.0 then
                      ([TsRow], [TsRow])
-> Recovery
-> Maybe Int
-> Date
-> Dates
-> [Rate]
-> [Rate]
-> [IRate]
-> (Rate, Int, Rate, Int, Period, AmortPlan, Int)
-> ([Recovery], [Recovery], [Recovery])
-> [TsRow]
projectDelinqMortgageFlow ([],[]) Recovery
backToPerfBal Maybe Int
forall a. Maybe a
Nothing (Dates
pDatesDates -> Int -> Date
forall a. HasCallStack => [a] -> Int -> a
!!Int
defaultLag) (Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
drop Int
defaultLag (Date
pDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
pDates))
                                                [Rate]
restPerfVector [Rate]
restPerfVector 
                                                (Int -> [IRate] -> [IRate]
forall a. Int -> [a] -> [a]
drop Int
defaultLag (IRate
rateIRate -> [IRate] -> [IRate]
forall a. a -> [a] -> [a]
:[IRate]
rates))
                                                (Rate
0,Int
0,Rate
0,Int
0,Period
p,AmortPlan
prinType,Int
ot)
                                                ([Recovery]
restPerfBal,[Recovery]
restPerfBal,[Recovery]
restPerfBal) -- `debug` ("\nStarting new perf >>> \n"++ show backToPerfBal)
                    else
                      []
       
       balAfterDelinq :: Recovery
balAfterDelinq = Recovery
beginBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
delinqBal
       ppyAmt :: Recovery
ppyAmt = Recovery -> Rate -> Recovery
mulBR Recovery
balAfterDelinq Rate
ppyRate 
       balAfterPpy :: Recovery
balAfterPpy  = Recovery
balAfterDelinq Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
ppyAmt
       periodRate :: IRate
periodRate = Period -> IRate -> IRate
periodRateFromAnnualRate Period
p IRate
rate
       amortTerm :: Int
amortTerm =  case AmortPlan
prinType of
                      Balloon Int
aTerm -> Int
aTerm
                      AmortPlan
_ -> Int
ot
       -- scheduleBalance = calcScheduleBalaceToday m  
       (Recovery
intAmt, Recovery
prinAmt) = AmortPlan
-> Recovery
-> IRate
-> Int
-> Int
-> (Recovery, Int)
-> (Recovery, Recovery)
calcAssetPrinInt AmortPlan
prinType Recovery
balAfterPpy IRate
periodRate Int
ot Int
remainTerms (Recovery
0,Int
amortTerm)

       endingBal :: Recovery
endingBal = Recovery
beginBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
prinAmt Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
ppyAmt Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
delinqBal -- `debug` ("DATE"++show pDate++">>>"++ show beginBal++">>"++show prinAmt ++ ">>" ++ show ppyAmt ++ ">>"++ show delinqBal)
       downFactor :: Rate
downFactor = Recovery -> Recovery -> Rate
divideBB Recovery
beginBal Recovery
endingBal
       newMbn :: Maybe Int
newMbn = Recovery -> Recovery -> Maybe Int -> Maybe Int
decreaseBorrowerNum Recovery
beginBal Recovery
endingBal Maybe Int
mbn
       tr :: TsRow
tr = Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
pDate Recovery
endingBal Recovery
prinAmt Recovery
intAmt Recovery
ppyAmt Recovery
delinqBal Recovery
dBal Recovery
rAmt Recovery
lAmt IRate
rate Maybe Int
newMbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing-- `debug` ("Date"++ show pDate ++ "ENDING BAL AT"++ show endingBal)


projectScheduleFlow :: [CF.TsRow] -> Rate -> Balance -> [CF.TsRow] -> [DefaultRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> (Int, Rate) -> [CF.TsRow]
projectScheduleFlow :: [TsRow]
-> Rate
-> Recovery
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Recovery]
-> [Recovery]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow [TsRow]
trs Rate
_ Recovery
last_bal [] [Rate]
_ [Rate]
_ [] [] (Int
_,Rate
_) = [TsRow]
trs 
projectScheduleFlow [TsRow]
trs Rate
bal_factor Recovery
last_bal (TsRow
flow:[TsRow]
flows) (Rate
defRate:[Rate]
defRates) (Rate
ppyRate:[Rate]
ppyRates) [Recovery]
recV [Recovery]
lossV (Int
recoveryLag,Rate
recoveryRate)
  = [TsRow]
-> Rate
-> Recovery
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Recovery]
-> [Recovery]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow ([TsRow]
trs[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow
tr]) Rate
surviveRate Recovery
endBal [TsRow]
flows [Rate]
defRates [Rate]
ppyRates ([Recovery] -> [Recovery]
forall a. HasCallStack => [a] -> [a]
tail [Recovery]
recVector) ([Recovery] -> [Recovery]
forall a. HasCallStack => [a] -> [a]
tail [Recovery]
lossVector) (Int
recoveryLag,Rate
recoveryRate) -- `debug` ("===>C")
     where
       startBal :: Recovery
startBal = Recovery
last_bal
       defAmt :: Recovery
defAmt = Recovery -> Rate -> Recovery
mulBR Recovery
startBal Rate
defRate
       ppyAmt :: Recovery
ppyAmt = Recovery -> Rate -> Recovery
mulBR (Recovery
startBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
defAmt) Rate
ppyRate 
       afterBal :: Recovery
afterBal = Recovery
startBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
defAmt Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
ppyAmt   
       
       surviveRate :: Rate
surviveRate = (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
defRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
ppyRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate
bal_factor 
       schedulePrin :: Recovery
schedulePrin = Recovery -> Rate -> Recovery
mulBR (TsRow -> Recovery
CF.mflowPrincipal TsRow
flow) Rate
surviveRate --TODO round trip  -- `debug` ("Schedule Principal"++(printf "%.2f" (CF.mflowPrincipal flow))++" Rate"++show(_schedule_rate))
       scheduleInt :: Recovery
scheduleInt = Recovery -> Rate -> Recovery
mulBR (TsRow -> Recovery
CF.mflowInterest TsRow
flow) Rate
surviveRate

       newRec :: Recovery
newRec = Recovery -> Rate -> Recovery
mulBR Recovery
defAmt Rate
recoveryRate
       newLoss :: Recovery
newLoss = Recovery -> Rate -> Recovery
mulBR Recovery
defAmt (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
recoveryRate)

       recVector :: [Recovery]
recVector = [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
recV Int
recoveryLag Recovery
newRec
       lossVector :: [Recovery]
lossVector = [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
lossV Int
recoveryLag Recovery
newLoss

       endBal :: Recovery
endBal = Recovery -> Recovery -> Recovery
forall a. Ord a => a -> a -> a
max Recovery
0 (Recovery -> Recovery) -> Recovery -> Recovery
forall a b. (a -> b) -> a -> b
$ Recovery
afterBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
schedulePrin

       tr :: TsRow
tr = Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate TsRow
flow) Recovery
endBal Recovery
schedulePrin Recovery
scheduleInt Recovery
ppyAmt Recovery
defAmt ([Recovery] -> Recovery
forall a. HasCallStack => [a] -> a
head [Recovery]
recVector) ([Recovery] -> Recovery
forall a. HasCallStack => [a] -> a
head [Recovery]
lossVector) IRate
0.0 Maybe Int
forall a. Maybe a
Nothing Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing--TODO missing ppy-penalty here

projectScheduleFlow [TsRow]
trs Rate
b_factor Recovery
lastBal [] [Rate]
_ [Rate]
_ (Recovery
r:[Recovery]
rs) (Recovery
l:[Recovery]
ls) (Int
recovery_lag,Rate
recovery_rate)
  = [TsRow]
-> Rate
-> Recovery
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Recovery]
-> [Recovery]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow ([TsRow]
trs[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow
tr]) Rate
b_factor Recovery
lastBal [] [] [] [Recovery]
rs [Recovery]
ls (Int
recovery_lag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1,Rate
recovery_rate) 
   where
      remain_length :: Int
remain_length = [Recovery] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Recovery]
rs
      lastDate :: Date
lastDate = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
trs)
      flowDate :: Date
flowDate = Date -> Period -> Date
nextDate Date
lastDate Period
Lib.Monthly
      tr :: TsRow
tr = Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
flowDate Recovery
lastBal Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
r Recovery
l IRate
0.0 Maybe Int
forall a. Maybe a
Nothing Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing

type DelinqRate = Rate
projectScheduleDelinqFlow :: ([CF.TsRow],[CF.TsRow]) -> Rate -> Balance -> [CF.TsRow] -> [DelinqRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> [Amount] -> (Rate,Int,Rate,Int) -> [CF.TsRow]
projectScheduleDelinqFlow :: ([TsRow], [TsRow])
-> Rate
-> Recovery
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Recovery]
-> [Recovery]
-> [Recovery]
-> (Rate, Int, Rate, Int)
-> [TsRow]
projectScheduleDelinqFlow ([TsRow]
trs,[]) Rate
_ Recovery
begBal [TsRow]
flows [] [] [Recovery]
defaults [Recovery]
recoveries [Recovery]
losses (Rate, Int, Rate, Int)
_ = 
  let 
    patchedFlows :: [TsRow]
patchedFlows = [ Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
d Recovery
begBal Recovery
prin Recovery
int Recovery
prepay Recovery
delinq Recovery
defVal Recovery
recVal Recovery
lossVal IRate
rate Maybe Int
mB Maybe Recovery
mPPN Maybe CumulativeStat
forall a. Maybe a
Nothing
                    | (CF.MortgageDelinqFlow Date
d Recovery
bal Recovery
prin Recovery
int Recovery
prepay Recovery
delinq Recovery
_ Recovery
_ Recovery
_ IRate
rate Maybe Int
mB Maybe Recovery
mPPN Maybe CumulativeStat
Nothing,Recovery
defVal,Recovery
recVal,Recovery
lossVal) <- [TsRow]
-> [Recovery]
-> [Recovery]
-> [Recovery]
-> [(TsRow, Recovery, Recovery, Recovery)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 [TsRow]
flows [Recovery]
defaults [Recovery]
recoveries [Recovery]
losses] -- `debug` ("Length of default"++ show defaults++">>recovery>>"++ show recoveries++">>loss>>"++ show losses)
    r1 :: [TsRow]
r1 = [TsRow] -> [TsRow]
forall a. Ord a => [a] -> [a]
sort ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [TsRow]
trs [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
patchedFlows -- `debug` ("Patched rows\n"++show patchedFlows)
  in 
    [TsRow]
r1
    
projectScheduleDelinqFlow ([TsRow]
trs,[TsRow]
newPerfs) Rate
_ Recovery
begBal [TsRow]
flows [] [] [Recovery]
defaults [Recovery]
recoveries [Recovery]
losses (Rate, Int, Rate, Int)
_ = 
  let 
    patchedFlows :: [TsRow]
patchedFlows = [ Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
d Recovery
begBal Recovery
prin Recovery
int Recovery
prepay Recovery
delinq Recovery
defVal Recovery
recVal Recovery
lossVal IRate
rate Maybe Int
mB Maybe Recovery
mPPN Maybe CumulativeStat
forall a. Maybe a
Nothing  
                    | (CF.MortgageDelinqFlow Date
d Recovery
bal Recovery
prin Recovery
int Recovery
prepay Recovery
delinq Recovery
_ Recovery
_ Recovery
_ IRate
rate Maybe Int
mB Maybe Recovery
mPPN Maybe CumulativeStat
Nothing,Recovery
defVal,Recovery
recVal,Recovery
lossVal) <- [TsRow]
-> [Recovery]
-> [Recovery]
-> [Recovery]
-> [(TsRow, Recovery, Recovery, Recovery)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 [TsRow]
flows [Recovery]
defaults [Recovery]
recoveries [Recovery]
losses] -- `debug` ("Length of default"++ show defaults++">>recovery>>"++ show recoveries++">>loss>>"++ show losses)
    r1 :: [TsRow]
r1 = [TsRow] -> [TsRow]
forall a. Ord a => [a] -> [a]
sort ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [TsRow]
trs [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
patchedFlows -- `debug` ("Patched rows\n"++show patchedFlows)
    r3 :: [TsRow]
r3 = [TsRow] -> [TsRow] -> [TsRow]
CF.aggregateTsByDate [] ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [TsRow] -> [TsRow]
forall a. Ord a => [a] -> [a]
sort [TsRow]
newPerfs -- `debug` ("New Perfs\n"++ show newPerfs)
    ([TsRow]
r1keep, [TsRow]
r1merge) = [TsRow] -> Date -> SplitType -> ([TsRow], [TsRow])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [TsRow]
r1 (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate  ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
r3)) SplitType
EqToRight  -- `debug` ("r3 \n"++ show r3)
    r4 :: [TsRow]
r4 = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
CF.combineTss [] [TsRow]
r1merge [TsRow]
r3 -- `debug` ("r1keep \n"++ show r1keep++"\n r1merge \n"++ show r1merge)
  in 
    [TsRow]
r1keep [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
r4 -- `debug` ("r4 \n"++ show r4)

projectScheduleDelinqFlow ([TsRow]
trs,[TsRow]
backToPerfCfs) Rate
surviveRate Recovery
begBal (TsRow
flow:[TsRow]
flows) (Rate
delinqRate:[Rate]
delinqRates) (Rate
ppyRate:[Rate]
ppyRates) (Recovery
defaultBal:[Recovery]
defaultBals) (Recovery
recoveryBal:[Recovery]
recoveryBals) (Recovery
lossBal:[Recovery]
lossBals) (Rate
defaultPct,Int
defaultLag,Rate
recoveryRate,Int
recoveryLag)
  = ([TsRow], [TsRow])
-> Rate
-> Recovery
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Recovery]
-> [Recovery]
-> [Recovery]
-> (Rate, Int, Rate, Int)
-> [TsRow]
projectScheduleDelinqFlow ([TsRow]
trs[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow
tr],[TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
CF.combineTss [] [TsRow]
backToPerfCfs [TsRow]
currentBackToPerfCfs) Rate
newSurviveRate Recovery
endBal [TsRow]
flows [Rate]
delinqRates [Rate]
ppyRates [Recovery]
newDefaultBals [Recovery]
newRecoveryBals [Recovery]
newLossBals (Rate
defaultPct,Int
defaultLag,Rate
recoveryRate,Int
recoveryLag) -- `debug` ("new back to perf flow"++ show backToPerfCfs)
    where 
      delinqAmt :: Recovery
delinqAmt = Recovery -> Rate -> Recovery
mulBR Recovery
begBal Rate
delinqRate -- `debug` ("delinq Rate"++ show delinqRate)
      ppyAmt :: Recovery
ppyAmt = Recovery -> Rate -> Recovery
mulBR (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
delinqAmt) Rate
ppyRate -- `debug` ("begbal"++ show begBal++">>"++ show delinqAmt)
      newSurviveRate :: Rate
newSurviveRate = (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
delinqRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
ppyRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate
surviveRate

      scheduleBal :: Recovery
scheduleBal = Getting Recovery TsRow Recovery -> TsRow -> Recovery
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Recovery TsRow Recovery
Lens' TsRow Recovery
CF.tsRowBalance TsRow
flow
      schedulePrin :: Recovery
schedulePrin = Recovery -> Rate -> Recovery
mulBR (TsRow -> Recovery
CF.mflowPrincipal TsRow
flow) Rate
surviveRate
      scheduleInt :: Recovery
scheduleInt = Recovery -> Rate -> Recovery
mulBR (TsRow -> Recovery
CF.mflowInterest TsRow
flow) Rate
surviveRate

      newDefaultBal :: Recovery
newDefaultBal = Recovery -> Rate -> Recovery
mulBR Recovery
delinqAmt Rate
defaultPct
      endBal :: Recovery
endBal = Recovery -> Recovery -> Recovery
forall a. Ord a => a -> a -> a
max Recovery
0 (Recovery -> Recovery) -> Recovery -> Recovery
forall a b. (a -> b) -> a -> b
$ (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
delinqAmt Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
ppyAmt Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
schedulePrin)
      currentBackToPerfCfs :: [TsRow]
currentBackToPerfCfs = let 
                               futureDs :: Dates
futureDs = Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
drop (Int
defaultLagInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
recoveryLag) (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ [TsRow] -> Dates
forall ts. TimeSeries ts => [ts] -> Dates
getDates (TsRow
flowTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
flows)
                               splitPct :: Rate
splitPct = Recovery -> Recovery -> Rate
divideBB (Recovery -> Rate -> Recovery
mulBR Recovery
delinqAmt (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
defaultPct)) Recovery
begBal
                               perfFlows :: [TsRow]
perfFlows = Int -> [TsRow] -> [TsRow]
forall a. Int -> [a] -> [a]
take ([TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
flows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
defaultLag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ Rate -> [TsRow] -> [TsRow]
CF.splitTrs Rate
splitPct (TsRow
flowTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
flows)
                             in 
                               [ ASetter TsRow TsRow Date Date -> Date -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Date Date
Lens' TsRow Date
CF.tsDate Date
d TsRow
f | (Date
d,TsRow
f) <- Dates -> [TsRow] -> [(Date, TsRow)]
forall a b. [a] -> [b] -> [(a, b)]
zip Dates
futureDs [TsRow]
perfFlows ]

      newDefaultBals :: [Recovery]
newDefaultBals = [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
defaultBals (Int -> Int
forall a. Enum a => a -> a
pred Int
defaultLag) Recovery
newDefaultBal  
      newRecoveryBals :: [Recovery]
newRecoveryBals = [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
recoveryBals (Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Enum a => a -> a
pred Int
defaultLag) (Recovery -> Rate -> Recovery
mulBR Recovery
newDefaultBal Rate
recoveryRate)  
      newLossBals :: [Recovery]
newLossBals =  [Recovery] -> Int -> Recovery -> [Recovery]
forall a. [a] -> Int -> a -> [a]
replace [Recovery]
lossBals (Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Enum a => a -> a
pred Int
defaultLag) (Recovery -> Rate -> Recovery
mulBR Recovery
newDefaultBal (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
recoveryRate)) -- `debug` ("new loss def"++ show defaultBal++">>rate"++ show (1-recoveryRate) )
      tr :: TsRow
tr = Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate TsRow
flow) Recovery
endBal Recovery
schedulePrin Recovery
scheduleInt Recovery
ppyAmt Recovery
delinqAmt Recovery
defaultBal Recovery
recoveryBal Recovery
lossBal (TsRow -> IRate
CF.mflowRate TsRow
flow) Maybe Int
forall a. Maybe a
Nothing 
                                 Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing -- `debug` ("|||>>> proj at date"++ show (CF.getDate flow))

-- | implementation on projection via default balance amount
projCashflowByDefaultAmt :: (Balance, Date, AmortPlan, Period,IRate,Maybe BorrowerNum) -> (Dates, ([Balance],[Balance]), [Rate], [IRate], [Int]) -> [CF.TsRow]
projCashflowByDefaultAmt :: (Recovery, Date, AmortPlan, Period, IRate, Maybe Int)
-> (Dates, ([Recovery], [Recovery]), [Rate], [IRate], [Int])
-> [TsRow]
projCashflowByDefaultAmt (Recovery
cb,Date
lastPayDate,AmortPlan
pt,Period
p,IRate
cr,Maybe Int
mbn) (Dates
cfDates,([Recovery]
expectedDefaultBals,[Recovery]
unAppliedDefaultBals), [Rate]
ppyRates, [IRate]
rateVector, [Int]
remainTerms) = 
  let 
    initRow :: TsRow
initRow = Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
lastPayDate Recovery
cb Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 IRate
cr Maybe Int
mbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing
  in 
    ([TsRow]
 -> (Date, (Recovery, Recovery), Rate, IRate, Int) -> [TsRow])
-> [TsRow]
-> [(Date, (Recovery, Recovery), Rate, IRate, Int)]
-> [TsRow]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
       (\[TsRow]
acc (Date
pDate, (Recovery
defaultBal,Recovery
futureDefualtBal), Rate
ppyRate, IRate
rate, Int
rt)
         -> let 
             begBal :: Recovery
begBal = Getting Recovery TsRow Recovery -> TsRow -> Recovery
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Recovery TsRow Recovery
Lens' TsRow Recovery
CF.tsRowBalance ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
acc)  
             mBorrower :: Maybe Int
mBorrower = TsRow -> Maybe Int
CF.mflowBorrowerNum ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
acc)   
             newDefault :: Recovery
newDefault = if Recovery
begBal Recovery -> Recovery -> Bool
forall a. Ord a => a -> a -> Bool
<= (Recovery
defaultBalRecovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
+Recovery
futureDefualtBal) then
                             Recovery
begBal  
                           else
                             Recovery
defaultBal   
             newPrepay :: Recovery
newPrepay = Recovery -> Rate -> Recovery
mulBR (Recovery -> Recovery -> Recovery
forall a. Ord a => a -> a -> a
max Recovery
0 (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newDefault)) Rate
ppyRate  -- `debug` ("mb from last"++ show mBorrower) 
             newInt :: Recovery
newInt = Recovery -> IRate -> Recovery
mulBI (Recovery -> Recovery -> Recovery
forall a. Ord a => a -> a -> a
max Recovery
0 (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newDefault Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrepay)) (Period -> IRate -> IRate
periodRateFromAnnualRate Period
p IRate
rate)
             intBal :: Recovery
intBal = Recovery -> Recovery -> Recovery
forall a. Ord a => a -> a -> a
max Recovery
0 (Recovery -> Recovery) -> Recovery -> Recovery
forall a b. (a -> b) -> a -> b
$ Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newDefault Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrepay -- `debug` ("using rt"++ show rt)
             newPrin :: Recovery
newPrin = case (Int
rt,AmortPlan
pt) of 
                         (Int
0,AmortPlan
_) -> Recovery
intBal
                         (Int
_,AmortPlan
Level) -> let 
                                    pmt :: Recovery
pmt = Recovery -> IRate -> Int -> Recovery
calcPmt Recovery
intBal (Period -> IRate -> IRate
periodRateFromAnnualRate Period
p IRate
rate) Int
rt -- `debug` ("PMT with rt"++ show rt)
                                  in 
                                    Recovery
pmt Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newInt
                         (Int
_,AmortPlan
Even) -> Recovery
intBal Recovery -> Recovery -> Recovery
forall a. Fractional a => a -> a -> a
/ Int -> Recovery
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rt
                         (Int, AmortPlan)
_ -> [Char] -> Recovery
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unsupport Prin type for mortgage"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AmortPlan -> [Char]
forall a. Show a => a -> [Char]
show AmortPlan
pt)
             endBal :: Recovery
endBal = Recovery
intBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrin
             newMbn :: Maybe Int
newMbn = Recovery -> Recovery -> Maybe Int -> Maybe Int
decreaseBorrowerNum Recovery
begBal Recovery
endBal Maybe Int
mBorrower  -- `debug` (">>> pdate"++ show pDate)
           in 
             [TsRow]
acc [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
pDate Recovery
endBal Recovery
newPrin Recovery
newInt Recovery
newPrepay Recovery
newDefault Recovery
0.0 Recovery
0.0 IRate
rate Maybe Int
newMbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing]                    
         )
       [TsRow
initRow]
       (Dates
-> [(Recovery, Recovery)]
-> [Rate]
-> [IRate]
-> [Int]
-> [(Date, (Recovery, Recovery), Rate, IRate, Int)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 Dates
cfDates ([Recovery] -> [Recovery] -> [(Recovery, Recovery)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Recovery]
expectedDefaultBals [Recovery]
unAppliedDefaultBals) [Rate]
ppyRates [IRate]
rateVector [Int]
remainTerms)

-- TODO to fix here , hard code on Left
calcScheduleBalaceToday :: Mortgage -> Maybe [RateAssumption] -> Date -> Balance 
calcScheduleBalaceToday :: Mortgage -> Maybe [RateAssumption] -> Date -> Recovery
calcScheduleBalaceToday Mortgage
m Maybe [RateAssumption]
mRates Date
asOfDay
  = let 
      sd :: Date
sd = Mortgage -> Date
forall a. Asset a => a -> Date
Ast.getOriginDate Mortgage
m
    in 
      case Mortgage
-> Date -> Maybe [RateAssumption] -> Either [Char] CashFlowFrame
forall a.
Asset a =>
a -> Date -> Maybe [RateAssumption] -> Either [Char] CashFlowFrame
calcCashflow (Mortgage -> Mortgage
forall a. Asset a => a -> a
resetToOrig Mortgage
m) Date
sd Maybe [RateAssumption]
mRates of
        Right (CF.CashFlowFrame BeginStatus
_ [TsRow]
scheduleTxn) ->
          case Date -> [TsRow] -> Maybe TsRow
forall ts. TimeSeries ts => Date -> [ts] -> Maybe ts
getByDate Date
asOfDay [TsRow]
scheduleTxn of
            Just TsRow
f -> Getting Recovery TsRow Recovery -> TsRow -> Recovery
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Recovery TsRow Recovery
Lens' TsRow Recovery
CF.tsRowBalance TsRow
f
            Maybe TsRow
Nothing -> [Char] -> Recovery
forall a. HasCallStack => [Char] -> a
error [Char]
"Failed to find schedule balance"
        Left [Char]
_ -> Recovery
0


-- | implementation on projection via default balance amount
projScheduleCashflowByDefaultAmt :: (Balance, Date,IRate,Maybe BorrowerNum) -> ([CF.TsRow], ([Balance],[Balance]), [Rate] ) -> ([CF.TsRow], Rate)
projScheduleCashflowByDefaultAmt :: (Recovery, Date, IRate, Maybe Int)
-> ([TsRow], ([Recovery], [Recovery]), [Rate]) -> ([TsRow], Rate)
projScheduleCashflowByDefaultAmt (Recovery
cb,Date
lastPayDate,IRate
cr,Maybe Int
mbn) ([TsRow]
scheduleFlows,([Recovery]
expectedDefaultBals,[Recovery]
unAppliedDefaultBals), [Rate]
ppyRates) = 
  let 
    initRow :: TsRow
initRow = Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
lastPayDate Recovery
cb Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 Recovery
0.0 IRate
cr Maybe Int
mbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing
  in 
    (([TsRow], Rate)
 -> (TsRow, (Recovery, Recovery), Rate) -> ([TsRow], Rate))
-> ([TsRow], Rate)
-> [(TsRow, (Recovery, Recovery), Rate)]
-> ([TsRow], Rate)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
       (\([TsRow]
acc,Rate
factor) (TsRow
cflow, (Recovery
defaultBal,Recovery
futureDefualtBal), Rate
ppyRate)
         -> let 
             pDate :: Date
pDate = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
cflow
             
             begBal :: Recovery
begBal = Getting Recovery TsRow Recovery -> TsRow -> Recovery
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Recovery TsRow Recovery
Lens' TsRow Recovery
CF.tsRowBalance ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
acc)  
             mBorrower :: Maybe Int
mBorrower = TsRow -> Maybe Int
CF.mflowBorrowerNum ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
acc)

             newDefault :: Recovery
newDefault = if Recovery
begBal Recovery -> Recovery -> Bool
forall a. Ord a => a -> a -> Bool
<= (Recovery
defaultBalRecovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
+Recovery
futureDefualtBal) then
                            Recovery
begBal  
                          else
                            Recovery
defaultBal   
             newPrepay :: Recovery
newPrepay = Recovery -> Rate -> Recovery
mulBR (Recovery -> Recovery -> Recovery
forall a. Ord a => a -> a -> a
max Recovery
0 (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newDefault)) Rate
ppyRate  -- `debug` ("mb from last"++ show mBorrower) 
             
             intBal :: Recovery
intBal = Recovery -> Recovery -> Recovery
forall a. Ord a => a -> a -> a
max Recovery
0 (Recovery -> Recovery) -> Recovery -> Recovery
forall a b. (a -> b) -> a -> b
$ Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newDefault Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrepay
             defRate :: Rate
defRate = if (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrepay) Recovery -> Recovery -> Bool
forall a. Eq a => a -> a -> Bool
/= Recovery
0 then 
                         Recovery -> Recovery -> Rate
divideBB Recovery
newDefault (Recovery
begBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrepay)
                       else
                         Rate
0
             newFactor :: Rate
newFactor = (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
ppyRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
defRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate
factor
             newInt :: Recovery
newInt = Recovery -> Rate -> Recovery
mulBR (TsRow -> Recovery
CF.mflowInterest TsRow
cflow) Rate
newFactor
             newPrin :: Recovery
newPrin = Recovery -> Rate -> Recovery
mulBR (TsRow -> Recovery
CF.mflowPrincipal TsRow
cflow) Rate
newFactor
             
             endBal :: Recovery
endBal = Recovery
intBal Recovery -> Recovery -> Recovery
forall a. Num a => a -> a -> a
- Recovery
newPrin
             newMbn :: Maybe Int
newMbn = Recovery -> Recovery -> Maybe Int -> Maybe Int
decreaseBorrowerNum Recovery
begBal Recovery
endBal Maybe Int
mBorrower 
           in 
             ([TsRow]
acc [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
pDate Recovery
endBal Recovery
newPrin Recovery
newInt Recovery
newPrepay Recovery
newDefault Recovery
0.0 Recovery
0.0
                       IRate
cr Maybe Int
newMbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing]                    
              ,Rate
newFactor)
         )
       ([TsRow
initRow],Rate
1.0)
       ([TsRow]
-> [(Recovery, Recovery)]
-> [Rate]
-> [(TsRow, (Recovery, Recovery), Rate)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [TsRow]
scheduleFlows ([Recovery] -> [Recovery] -> [(Recovery, Recovery)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Recovery]
expectedDefaultBals [Recovery]
unAppliedDefaultBals) [Rate]
ppyRates)

buildARMrates :: IR.RateType -> (ARM,Date,Date,Date,IRate) -> Maybe [RateAssumption] -> Ts
buildARMrates :: RateType
-> (ARM, Date, Date, Date, IRate) -> Maybe [RateAssumption] -> Ts
buildARMrates (IR.Fix DayCount
_ IRate
_ ) (ARM, Date, Date, Date, IRate)
_ Maybe [RateAssumption]
_ = [Char] -> Ts
forall a. HasCallStack => [Char] -> a
error [Char]
"ARM should have floater rate"
buildARMrates or :: RateType
or@(IR.Floater DayCount
_ Index
idx IRate
sprd IRate
initRate DatePattern
dp RateFloor
_ RateFloor
_ Maybe (RoundingBy IRate)
mRoundBy ) 
              (ARM
arm, Date
startDate, Date
firstResetDate, Date
lastCfDate, IRate
beginRate) Maybe [RateAssumption]
mRates
  = let 
      resetDates :: Dates
resetDates = RangeType -> Date -> DatePattern -> Date -> Dates
genSerialDatesTill2 RangeType
IE Date
firstResetDate DatePattern
dp Date
lastCfDate
      projectFutureActualCurve :: Ts -> Ts
projectFutureActualCurve = ARM -> (Date, IRate) -> RateType -> Dates -> Ts -> Ts
runInterestRate2 ARM
arm (Date
startDate,IRate
beginRate) RateType
or Dates
resetDates
    in 
      case [RateAssumption] -> Index -> Maybe RateAssumption
A.getRateAssumption ([RateAssumption] -> Maybe [RateAssumption] -> [RateAssumption]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RateAssumption]
mRates) Index
idx of
        Just (RateCurve Index
idx Ts
curve) 
          -> Ts -> Ts
projectFutureActualCurve Ts
curve 
        Just (RateFlat Index
idx IRate
v) 
          -> Ts -> Ts
projectFutureActualCurve ([(Date, IRate)] -> Ts
mkRateTs [(Date
startDate, IRate
v),(Date
lastCfDate,IRate
v)]) -- `debug` ("lpd"++show last_pay_date++"lpd"++ show (last cf_dates))
        Maybe RateAssumption
Nothing -> [Char] -> Ts
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ts) -> [Char] -> Ts
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to find index"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Index -> [Char]
forall a. Show a => a -> [Char]
show Index
idx

instance Ast.Asset Mortgage where
  calcCashflow :: Mortgage
-> Date -> Maybe [RateAssumption] -> Either [Char] CashFlowFrame
calcCashflow m :: Mortgage
m@(Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
ptype Maybe PrepayPenaltyType
_ Maybe Obligor
_)  Recovery
_bal IRate
_rate Int
_term Maybe Int
_mbn Status
_) Date
d Maybe [RateAssumption]
mRates
    = (CashFlowFrame, Map CutoffFields Recovery) -> CashFlowFrame
forall a b. (a, b) -> a
fst ((CashFlowFrame, Map CutoffFields Recovery) -> CashFlowFrame)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] CashFlowFrame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mortgage
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
projCashflow Mortgage
m Date
d (Maybe AssetDefaultAssumption
-> Maybe AssetPrepayAssumption
-> Maybe RecoveryAssumption
-> Maybe ExtraStress
-> AssetPerfAssumption
MortgageAssump Maybe AssetDefaultAssumption
forall a. Maybe a
Nothing Maybe AssetPrepayAssumption
forall a. Maybe a
Nothing Maybe RecoveryAssumption
forall a. Maybe a
Nothing Maybe ExtraStress
forall a. Maybe a
Nothing
                                  ,AssetDelinqPerfAssumption
A.DummyDelinqAssump
                                  ,AssetDefaultedPerfAssumption
A.DummyDefaultAssump) Maybe [RateAssumption]
mRates)

  calcCashflow s :: Mortgage
s@(ScheduleMortgageFlow Date
beg_date [TsRow]
flows DatePattern
_)  Date
d Maybe [RateAssumption]
_ 
    = CashFlowFrame -> Either [Char] CashFlowFrame
forall a b. b -> Either a b
Right (CashFlowFrame -> Either [Char] CashFlowFrame)
-> CashFlowFrame -> Either [Char] CashFlowFrame
forall a b. (a -> b) -> a -> b
$ BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame ( ((Getting Recovery TsRow Recovery -> TsRow -> Recovery
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Recovery TsRow Recovery
Lens' TsRow Recovery
CF.tsRowBalance) (TsRow -> Recovery) -> ([TsRow] -> TsRow) -> [TsRow] -> Recovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head) [TsRow]
flows, Date
beg_date, Maybe Recovery
forall a. Maybe a
Nothing ) [TsRow]
flows

  calcCashflow m :: Mortgage
m@(AdjustRateMortgage OriginalInfo
_origin ARM
_arm  Recovery
_bal IRate
_rate Int
_term Maybe Int
_mbn Status
_status) Date
d Maybe [RateAssumption]
mRates = [Char] -> Either [Char] CashFlowFrame
forall a b. a -> Either a b
Left ([Char] -> Either [Char] CashFlowFrame)
-> [Char] -> Either [Char] CashFlowFrame
forall a b. (a -> b) -> a -> b
$ [Char]
"to be implement on adjust rate mortgage"
  
  getCurrentBal :: Mortgage -> Recovery
getCurrentBal (Mortgage OriginalInfo
_ Recovery
_bal IRate
_ Int
_ Maybe Int
_ Status
_) = Recovery
_bal
  getCurrentBal (AdjustRateMortgage OriginalInfo
_ ARM
_ Recovery
_bal IRate
_ Int
_ Maybe Int
_ Status
_) = Recovery
_bal

  getOriginBal :: Mortgage -> Recovery
getOriginBal (Mortgage (MortgageOriginalInfo Recovery
_bal RateType
_ Int
_ Period
_ Date
_ AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) Recovery
_ IRate
_ Int
_ Maybe Int
_ Status
_ ) = Recovery
_bal
  getOriginBal (AdjustRateMortgage (MortgageOriginalInfo Recovery
_bal RateType
_ Int
_ Period
_ Date
_ AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) ARM
_ Recovery
_ IRate
_ Int
_ Maybe Int
_ Status
_ ) = Recovery
_bal
  
  getOriginRate :: Mortgage -> IRate
getOriginRate Mortgage
m
    = let 
        (MortgageOriginalInfo Recovery
_ RateType
or Int
_ Period
_ Date
_ AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) = Mortgage -> OriginalInfo
forall a. Asset a => a -> OriginalInfo
getOriginInfo Mortgage
m
      in  
        case RateType
or of
          IR.Fix DayCount
_ IRate
_r -> IRate
_r
          IR.Floater DayCount
_ Index
_ IRate
_ IRate
_r DatePattern
_ RateFloor
_ RateFloor
_ Maybe (RoundingBy IRate)
_ -> IRate
_r 

  getCurrentRate :: Mortgage -> IRate
getCurrentRate (Mortgage OriginalInfo
_ Recovery
_ IRate
r Int
_ Maybe Int
_ Status
_) = IRate
r
  getCurrentRate (AdjustRateMortgage OriginalInfo
_ ARM
_ Recovery
_ IRate
r Int
_ Maybe Int
_ Status
_) = IRate
r
  getCurrentRate (ScheduleMortgageFlow Date
_ [TsRow]
flows DatePattern
_) = IRate
0.0

  resetToOrig :: Mortgage -> Mortgage
resetToOrig m :: Mortgage
m@(Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
pt Maybe PrepayPenaltyType
pp Maybe Obligor
obr) Recovery
cb IRate
cr Int
rt Maybe Int
mBn Status
st)
    = OriginalInfo
-> Recovery -> IRate -> Int -> Maybe Int -> Status -> Mortgage
Mortgage (Recovery
-> RateType
-> Int
-> Period
-> Date
-> AmortPlan
-> Maybe PrepayPenaltyType
-> Maybe Obligor
-> OriginalInfo
MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
pt Maybe PrepayPenaltyType
pp Maybe Obligor
obr) 
                Recovery
ob 
                (Mortgage -> IRate
forall a. Asset a => a -> IRate
getOriginRate Mortgage
m)
                Int
ot 
                Maybe Int
mBn
                Status
st  --TODO borrowerNum is not being updated
  resetToOrig m :: Mortgage
m@(AdjustRateMortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
pt Maybe PrepayPenaltyType
pp Maybe Obligor
obr) ARM
arm Recovery
cb IRate
cr Int
rt Maybe Int
mBn Status
st)
    = OriginalInfo
-> ARM
-> Recovery
-> IRate
-> Int
-> Maybe Int
-> Status
-> Mortgage
AdjustRateMortgage (Recovery
-> RateType
-> Int
-> Period
-> Date
-> AmortPlan
-> Maybe PrepayPenaltyType
-> Maybe Obligor
-> OriginalInfo
MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
pt Maybe PrepayPenaltyType
pp Maybe Obligor
obr) 
                         ARM
arm 
                         Recovery
ob 
                         (Mortgage -> IRate
forall a. Asset a => a -> IRate
getOriginRate Mortgage
m)
                         Int
ot 
                         Maybe Int
mBn
                         Status
st  --TODO borrowerNum is not being updated
  resetToOrig m :: Mortgage
m@(ScheduleMortgageFlow Date
begDate [TsRow]
flows DatePattern
dp) = Mortgage
m

  getPaymentDates :: Mortgage -> Int -> Dates
getPaymentDates (Mortgage (MortgageOriginalInfo Recovery
_ RateType
_ Int
ot Period
p Date
sd AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) Recovery
_ IRate
_ Int
_ Maybe Int
_ Status
_) Int
extra = Date -> Period -> Int -> Dates
genDates Date
sd Period
p (Int
otInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
extra)
  getPaymentDates (AdjustRateMortgage (MortgageOriginalInfo Recovery
_ RateType
_ Int
ot Period
p Date
sd AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) ARM
_ Recovery
_ IRate
_ Int
_ Maybe Int
_ Status
_) Int
extra = Date -> Period -> Int -> Dates
genDates Date
sd Period
p (Int
otInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
extra)
  getPaymentDates (ScheduleMortgageFlow Date
begDate [TsRow]
flows DatePattern
dp) Int
extra 
    = let 
        lastPayDay :: Date
lastPayDay = (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsRow -> Date) -> ([TsRow] -> TsRow) -> [TsRow] -> Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last) [TsRow]
flows
        extDates :: Dates
extDates = DatePattern -> CutoffType -> Date -> Int -> Dates
genSerialDates DatePattern
dp CutoffType
Exc Date
lastPayDay Int
extra 
      in 
        [TsRow] -> Dates
forall ts. TimeSeries ts => [ts] -> Dates
getDates [TsRow]
flows Dates -> Dates -> Dates
forall a. [a] -> [a] -> [a]
++ Dates
extDates

  isDefaulted :: Mortgage -> Bool
isDefaulted (Mortgage OriginalInfo
_ Recovery
_ IRate
_ Int
_ Maybe Int
_ (Defaulted Maybe Date
_)) = Bool
True
  isDefaulted (AdjustRateMortgage OriginalInfo
_ ARM
_ Recovery
_ IRate
_ Int
_ Maybe Int
_ (Defaulted Maybe Date
_)) = Bool
True
  isDefaulted Mortgage {} = Bool
False
  isDefaulted AdjustRateMortgage {} = Bool
False
  
  getOriginDate :: Mortgage -> Date
getOriginDate (Mortgage (MortgageOriginalInfo Recovery
_ RateType
_ Int
ot Period
p Date
sd AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) Recovery
_ IRate
_ Int
ct Maybe Int
_ Status
_) = Date
sd
  getOriginDate (AdjustRateMortgage (MortgageOriginalInfo Recovery
_ RateType
_ Int
ot Period
p Date
sd AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) ARM
_ Recovery
_ IRate
_ Int
ct Maybe Int
_ Status
_) = Date
sd
  getOriginDate (ScheduleMortgageFlow Date
begDate [TsRow]
_ DatePattern
_) = Date
begDate

  getRemainTerms :: Mortgage -> Int
getRemainTerms (Mortgage (MortgageOriginalInfo Recovery
_ RateType
_ Int
ot Period
p Date
sd AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) Recovery
_ IRate
_ Int
ct Maybe Int
_ Status
_) = Int
ct
  getRemainTerms (AdjustRateMortgage (MortgageOriginalInfo Recovery
_ RateType
_ Int
ot Period
p Date
sd AmortPlan
_ Maybe PrepayPenaltyType
_ Maybe Obligor
_) ARM
_ Recovery
_ IRate
_ Int
ct Maybe Int
_ Status
_) = Int
ct

  getOriginInfo :: Mortgage -> OriginalInfo
getOriginInfo (Mortgage OriginalInfo
oi Recovery
_ IRate
_ Int
_ Maybe Int
_ Status
_) = OriginalInfo
oi
  getOriginInfo (AdjustRateMortgage OriginalInfo
oi ARM
_ Recovery
_ IRate
_ Int
_ Maybe Int
_ Status
_) = OriginalInfo
oi

  updateOriginDate :: Mortgage -> Date -> Mortgage
updateOriginDate (Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
_type Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) Recovery
cb IRate
cr Int
ct Maybe Int
mbn Status
st) Date
nd 
    = OriginalInfo
-> Recovery -> IRate -> Int -> Maybe Int -> Status -> Mortgage
Mortgage (Recovery
-> RateType
-> Int
-> Period
-> Date
-> AmortPlan
-> Maybe PrepayPenaltyType
-> Maybe Obligor
-> OriginalInfo
MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
nd AmortPlan
_type Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) Recovery
cb IRate
cr Int
ct Maybe Int
mbn Status
st 
  updateOriginDate (AdjustRateMortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
_type Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) ARM
arm Recovery
cb IRate
cr Int
ct Maybe Int
mbn Status
st) Date
nd 
    = OriginalInfo
-> ARM
-> Recovery
-> IRate
-> Int
-> Maybe Int
-> Status
-> Mortgage
AdjustRateMortgage (Recovery
-> RateType
-> Int
-> Period
-> Date
-> AmortPlan
-> Maybe PrepayPenaltyType
-> Maybe Obligor
-> OriginalInfo
MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
nd AmortPlan
_type Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) ARM
arm Recovery
cb IRate
cr Int
ct Maybe Int
mbn Status
st

  -- project current mortgage with total default amt 
  projCashflow :: Mortgage
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
projCashflow m :: Mortgage
m@(Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
_) Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
Current) 
               Date
asOfDay 
               mars :: AssetPerf
mars@(A.MortgageAssump (Just (A.DefaultByAmt (Recovery
dBal,[Rate]
vs))) Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams ,AssetDelinqPerfAssumption
_ ,AssetDefaultedPerfAssumption
_) 
               Maybe [RateAssumption]
mRates =
      let
        recoveryLag :: Int
recoveryLag = Int
-> (RecoveryAssumption -> Int) -> Maybe RecoveryAssumption -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 RecoveryAssumption -> Int
getRecoveryLag Maybe RecoveryAssumption
amr
        Date
lastPayDate:Dates
cfDates = Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
lastN (Int -> Int
forall a. Enum a => a -> a
succ (Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rt)) (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Mortgage -> Int -> Dates
forall a. Asset a => a -> Int -> Dates
getPaymentDates Mortgage
m Int
recoveryLag
        expectedDefaultBals :: [Recovery]
expectedDefaultBals = Recovery -> [Recovery] -> Int -> [Recovery]
forall a. a -> [a] -> Int -> [a]
paddingDefault Recovery
0 (Recovery -> Rate -> Recovery
mulBR Recovery
dBal (Rate -> Recovery) -> [Rate] -> [Recovery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
vs) (Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates)
        unAppliedDefaultBals :: [Recovery]
unAppliedDefaultBals = [Recovery] -> [Recovery]
forall a. HasCallStack => [a] -> [a]
tail ([Recovery] -> [Recovery]) -> [Recovery] -> [Recovery]
forall a b. (a -> b) -> a -> b
$ (Recovery -> Recovery -> Recovery)
-> Recovery -> [Recovery] -> [Recovery]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) Recovery
dBal [Recovery]
expectedDefaultBals
        remainTerms :: [Int]
remainTerms = Int -> [Int] -> Int -> [Int]
forall a. a -> [a] -> Int -> [a]
paddingDefault Int
0 ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0..(Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
recoveryLag)]) (Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates)
      in
        do 
          [IRate]
rateVector <- IRate
-> RateType
-> Maybe [RateAssumption]
-> Dates
-> Either [Char] [IRate]
A.projRates IRate
cr RateType
or Maybe [RateAssumption]
mRates Dates
cfDates 
          [Rate]
ppyRates <- Mortgage
-> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
forall b.
Asset b =>
b -> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
Ast.buildPrepayRates Mortgage
m (Date
lastPayDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) Maybe AssetPrepayAssumption
amp
          let txns :: [TsRow]
txns = (Recovery, Date, AmortPlan, Period, IRate, Maybe Int)
-> (Dates, ([Recovery], [Recovery]), [Rate], [IRate], [Int])
-> [TsRow]
projCashflowByDefaultAmt (Recovery
cb,Date
lastPayDate,AmortPlan
prinPayType,Period
p,IRate
cr,Maybe Int
mbn) 
                                              (Dates
cfDates,([Recovery]
expectedDefaultBals,[Recovery]
unAppliedDefaultBals),[Rate]
ppyRates,[IRate]
rateVector,[Int]
remainTerms)
          let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM)= Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay ([TsRow] -> Maybe RecoveryAssumption -> [TsRow]
patchLossRecovery [TsRow]
txns Maybe RecoveryAssumption
amr)
          let begBal :: Recovery
begBal = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
          (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (Int, Maybe PrepayPenaltyType) -> CashFlowFrame -> CashFlowFrame
patchPrepayPenaltyFlow (Int
ot,Maybe PrepayPenaltyType
mpn) (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBal,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)
  
  -- project current adjMortgage with total default amt
  projCashflow m :: Mortgage
m@(AdjustRateMortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
_) ARM
arm Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
Current) 
               Date
asOfDay 
               mars :: AssetPerf
mars@(A.MortgageAssump (Just (A.DefaultByAmt (Recovery
dBal,[Rate]
vs))) Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams,AssetDelinqPerfAssumption
_,AssetDefaultedPerfAssumption
_) 
               Maybe [RateAssumption]
mRates =
      let
        ARM Int
initPeriod RateFloor
initCap RateFloor
periodicCap RateFloor
lifeCap RateFloor
lifeFloor = ARM
arm
        passInitPeriod :: Bool
passInitPeriod = (Int
ot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rt) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
initPeriod 
        firstResetDate :: Date
firstResetDate = Date -> Integer -> Date
monthsAfter Date
sd (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Int
forall a. Enum a => a -> a
succ Int
initPeriod))

        Date
lastPayDate:Dates
cfDates = SliceType -> Dates -> Dates
sliceDates (Date -> SliceType
SliceOnAfterKeepPrevious Date
asOfDay)  (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
lastN (Int
rt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Mortgage -> Int -> Dates
forall a. Asset a => a -> Int -> Dates
getPaymentDates Mortgage
m Int
recoveryLag 
        rateCurve :: Ts
rateCurve = RateType
-> (ARM, Date, Date, Date, IRate) -> Maybe [RateAssumption] -> Ts
buildARMrates RateType
or (ARM
arm, Date
sd, Date
firstResetDate, Dates -> Date
forall a. HasCallStack => [a] -> a
last Dates
cfDates, Mortgage -> IRate
forall a. Asset a => a -> IRate
getOriginRate Mortgage
m) Maybe [RateAssumption]
mRates
        rateVector :: [IRate]
rateVector = Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational (Rate -> IRate) -> [Rate] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ts -> CutoffType -> Dates -> [Rate]
getValByDates Ts
rateCurve CutoffType
Inc Dates
cfDates 
        expectedDefaultBals :: [Recovery]
expectedDefaultBals = Recovery -> [Recovery] -> Int -> [Recovery]
forall a. a -> [a] -> Int -> [a]
paddingDefault Recovery
0 (Recovery -> Rate -> Recovery
mulBR Recovery
dBal (Rate -> Recovery) -> [Rate] -> [Recovery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
vs) (Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates)
        unAppliedDefaultBals :: [Recovery]
unAppliedDefaultBals = [Recovery] -> [Recovery]
forall a. HasCallStack => [a] -> [a]
tail ([Recovery] -> [Recovery]) -> [Recovery] -> [Recovery]
forall a b. (a -> b) -> a -> b
$ (Recovery -> Recovery -> Recovery)
-> Recovery -> [Recovery] -> [Recovery]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) Recovery
dBal [Recovery]
expectedDefaultBals
        recoveryLag :: Int
recoveryLag = Int
-> (RecoveryAssumption -> Int) -> Maybe RecoveryAssumption -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 RecoveryAssumption -> Int
getRecoveryLag Maybe RecoveryAssumption
amr
        remainTerms :: [Int]
remainTerms = Int -> [Int] -> Int -> [Int]
forall a. a -> [a] -> Int -> [a]
paddingDefault Int
0 ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0..(Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
recoveryLag)]) (Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates)
      in
        do
          [Rate]
ppyRates <- Mortgage
-> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
forall b.
Asset b =>
b -> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
Ast.buildPrepayRates Mortgage
m (Date
lastPayDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) Maybe AssetPrepayAssumption
amp
          let txns :: [TsRow]
txns = (Recovery, Date, AmortPlan, Period, IRate, Maybe Int)
-> (Dates, ([Recovery], [Recovery]), [Rate], [IRate], [Int])
-> [TsRow]
projCashflowByDefaultAmt (Recovery
cb,Date
lastPayDate,AmortPlan
prinPayType,Period
p,IRate
cr,Maybe Int
mbn) (Dates
cfDates,([Recovery]
expectedDefaultBals,[Recovery]
unAppliedDefaultBals),[Rate]
ppyRates,[IRate]
rateVector,[Int]
remainTerms)
          let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM)= Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay ([TsRow] -> Maybe RecoveryAssumption -> [TsRow]
patchLossRecovery [TsRow]
txns Maybe RecoveryAssumption
amr)
          let begBal :: Recovery
begBal = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
          (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (Int, Maybe PrepayPenaltyType) -> CashFlowFrame -> CashFlowFrame
patchPrepayPenaltyFlow (Int
ot,Maybe PrepayPenaltyType
mpn) (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBal,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)
  -- project schedule cashflow with total default amount
  projCashflow m :: Mortgage
m@(ScheduleMortgageFlow Date
begDate [TsRow]
flows DatePattern
dp) Date
asOfDay 
              assumps :: AssetPerf
assumps@(pAssump :: AssetPerfAssumption
pAssump@(A.MortgageAssump (Just (A.DefaultByAmt (Recovery
dBal,[Rate]
vs))) Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams ),AssetDelinqPerfAssumption
dAssump,AssetDefaultedPerfAssumption
fAssump) Maybe [RateAssumption]
_
    = let
        begBal :: Recovery
begBal =  TsRow -> Recovery
CF.mflowBegBalance (TsRow -> Recovery) -> TsRow -> Recovery
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
flows
        begDate :: Date
begDate = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsRow -> Date) -> TsRow -> Date
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
flows 
        begRate :: IRate
begRate = TsRow -> IRate
CF.mflowRate (TsRow -> IRate) -> TsRow -> IRate
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
flows 
        begMbn :: Maybe Int
begMbn = TsRow -> Maybe Int
CF.mflowBorrowerNum (TsRow -> Maybe Int) -> TsRow -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
flows 
        originCfDates :: Dates
originCfDates = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate (TsRow -> Date) -> [TsRow] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
flows 
        originFlowSize :: Int
originFlowSize = [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
flows
        recoveryLag :: Int
recoveryLag = Int
-> (RecoveryAssumption -> Int) -> Maybe RecoveryAssumption -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 RecoveryAssumption -> Int
getRecoveryLag Maybe RecoveryAssumption
amr
        totalLength :: Int
totalLength = Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
originFlowSize
        expectedDefaultBals :: [Recovery]
expectedDefaultBals = Recovery -> [Recovery] -> Int -> [Recovery]
forall a. a -> [a] -> Int -> [a]
paddingDefault Recovery
0 (Recovery -> Rate -> Recovery
mulBR Recovery
dBal (Rate -> Recovery) -> [Rate] -> [Recovery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
vs) Int
totalLength
        unAppliedDefaultBals :: [Recovery]
unAppliedDefaultBals = [Recovery] -> [Recovery]
forall a. HasCallStack => [a] -> [a]
tail ([Recovery] -> [Recovery]) -> [Recovery] -> [Recovery]
forall a b. (a -> b) -> a -> b
$ (Recovery -> Recovery -> Recovery)
-> Recovery -> [Recovery] -> [Recovery]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) Recovery
dBal [Recovery]
expectedDefaultBals
        endDate :: Date
endDate = (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate (TsRow -> Date) -> ([TsRow] -> TsRow) -> [TsRow] -> Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last) [TsRow]
flows
        extraDates :: Dates
extraDates = DatePattern -> CutoffType -> Date -> Int -> Dates
genSerialDates DatePattern
dp CutoffType
Exc Date
endDate Int
recoveryLag
        flowsWithEx :: [TsRow]
flowsWithEx = [TsRow]
flows [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ TsRow -> Dates -> [TsRow]
extendTxns ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
flows) Dates
extraDates -- `debug` (">> end date"++ show endDate++">>> extra dates"++show extraDates)
      in
        do 
          [Rate]
_ppyRate <- Mortgage
-> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
forall b.
Asset b =>
b -> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
Ast.buildPrepayRates Mortgage
m (Date
begDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
originCfDates) Maybe AssetPrepayAssumption
amp
          let ppyRates :: [Rate]
ppyRates = Rate -> [Rate] -> Int -> [Rate]
forall a. a -> [a] -> Int -> [a]
paddingDefault Rate
0.0 [Rate]
_ppyRate Int
totalLength
          let ([TsRow]
txns,Rate
_) = (Recovery, Date, IRate, Maybe Int)
-> ([TsRow], ([Recovery], [Recovery]), [Rate]) -> ([TsRow], Rate)
projScheduleCashflowByDefaultAmt 
                          (Recovery
begBal,Date
begDate,IRate
begRate,Maybe Int
begMbn) 
                          ([TsRow]
flowsWithEx,([Recovery]
expectedDefaultBals,[Recovery]
unAppliedDefaultBals),[Rate]
ppyRates) -- `debug` ("exted flows"++ show flowsWithEx)
          let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM) = Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay ([TsRow] -> Maybe RecoveryAssumption -> [TsRow]
patchLossRecovery [TsRow]
txns Maybe RecoveryAssumption
amr) -- `debug` ("txn"++show txns)
          let begBalAfterCut :: Recovery
begBalAfterCut = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
          (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBalAfterCut,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)  -- `debug` ("Future txn"++ show futureTxns)

  -- project current mortgage(without delinq)
  projCashflow m :: Mortgage
m@(Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
_) Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
Current) 
               Date
asOfDay 
               mars :: AssetPerf
mars@(A.MortgageAssump Maybe AssetDefaultAssumption
amd Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams ,AssetDelinqPerfAssumption
_ ,AssetDefaultedPerfAssumption
_) 
               Maybe [RateAssumption]
mRates =
    let
      recoveryLag :: Int
recoveryLag = Int
-> (RecoveryAssumption -> Int) -> Maybe RecoveryAssumption -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 RecoveryAssumption -> Int
getRecoveryLag Maybe RecoveryAssumption
amr
      Date
lastPayDate:Dates
cfDates = Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
lastN (Int
rt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Mortgage -> Int -> Dates
forall a. Asset a => a -> Int -> Dates
getPaymentDates Mortgage
m Int
0
      cfDatesLength :: Int
cfDatesLength = Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates 
      remainTerms :: [Int]
remainTerms = [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0..Int
rt]
      dc :: DayCount
dc = RateType -> DayCount
getDayCount RateType
or -- `debug` ("day count"++ show dc)
      recoveryDates :: Dates
recoveryDates = Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
lastN Int
recoveryLag (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Mortgage -> Int -> Dates
forall a. Asset a => a -> Int -> Dates
getPaymentDates Mortgage
m Int
recoveryLag
    in  
      do
        [IRate]
rateVector <- IRate
-> RateType
-> Maybe [RateAssumption]
-> Dates
-> Either [Char] [IRate]
A.projRates IRate
cr RateType
or Maybe [RateAssumption]
mRates Dates
cfDates 
        [Rate]
defRates <- Mortgage
-> Dates -> Maybe AssetDefaultAssumption -> Either [Char] [Rate]
forall b.
Asset b =>
b -> Dates -> Maybe AssetDefaultAssumption -> Either [Char] [Rate]
Ast.buildDefaultRates Mortgage
m (Date
lastPayDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) Maybe AssetDefaultAssumption
amd
        [Rate]
ppyRates <- Mortgage
-> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
forall b.
Asset b =>
b -> Dates -> Maybe AssetPrepayAssumption -> Either [Char] [Rate]
Ast.buildPrepayRates Mortgage
m (Date
lastPayDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) Maybe AssetPrepayAssumption
amp
        let (DList TsRow
txns',Recovery
_,Recovery
_) = (Recovery, Recovery, Date, Maybe Int, AmortPlan, DayCount, IRate,
 Period, Int)
-> (Dates, [Rate], [Rate], [IRate], [Int])
-> (DList TsRow, Recovery, Recovery)
projectMortgageFlow 
                          (Recovery
ob, Recovery
cb,Date
lastPayDate,Maybe Int
mbn,AmortPlan
prinPayType,DayCount
dc,IRate
cr,Period
p,Int
ot) 
                          (Dates
cfDates, [Rate]
defRates, [Rate]
ppyRates,[IRate]
rateVector,[Int]
remainTerms)
        let txns :: [TsRow]
txns = DList TsRow -> [TsRow]
forall a. DList a -> [a]
DL.toList DList TsRow
txns'
        let lastProjTxn :: TsRow
lastProjTxn = [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
txns
        let extraTxns :: [TsRow]
extraTxns = [ Date -> TsRow -> TsRow
CF.emptyTsRow Date
d TsRow
lastProjTxn  | Date
d <- Dates
recoveryDates ]
      
        let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM)= Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay ([TsRow] -> Maybe RecoveryAssumption -> [TsRow]
patchLossRecovery ([TsRow]
txns[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow]
extraTxns) Maybe RecoveryAssumption
amr)
        let begBal :: Recovery
begBal = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
        (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (Int, Maybe PrepayPenaltyType) -> CashFlowFrame -> CashFlowFrame
patchPrepayPenaltyFlow (Int
ot,Maybe PrepayPenaltyType
mpn) (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBal,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)

  -- project current mortgage(with delinq)
  projCashflow m :: Mortgage
m@(Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
_) Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
Current) 
               Date
asOfDay 
               mars :: AssetPerf
mars@(A.MortgageDeqAssump Maybe AssetDelinquencyAssumption
amd Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams
                    ,AssetDelinqPerfAssumption
_
                    ,AssetDefaultedPerfAssumption
_) 
               Maybe [RateAssumption]
mRates =
    let
      (Rate
recoveryRate, Int
recoveryLag) = Maybe RecoveryAssumption -> (Rate, Int)
Ast.getRecoveryLagAndRate Maybe RecoveryAssumption
amr
      Date
lastPayDate:Dates
cfDates = Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
lastN (Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
defaultLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Mortgage -> Int -> Dates
forall a. Asset a => a -> Int -> Dates
getPaymentDates Mortgage
m (Int
recoveryLagInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
defaultLag)
      ([Rate]
_,Int
defaultLag,Rate
defaultPct) = Maybe AssetDelinquencyAssumption -> Dates -> ([Rate], Int, Rate)
Ast.getDefaultDelinqAssump Maybe AssetDelinquencyAssumption
amd Dates
cfDates
      cfDatesLength :: Int
cfDatesLength = Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
defaultLag
    in
      do 
        [IRate]
rateVector <- IRate
-> RateType
-> Maybe [RateAssumption]
-> Dates
-> Either [Char] [IRate]
A.projRates IRate
cr RateType
or Maybe [RateAssumption]
mRates Dates
cfDates
        ([Rate]
ppyRates,[Rate]
delinqRates,(Rate
_,Int
_),Rate
_,Int
_) <- Mortgage
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], (Rate, Int), Rate, Int)
forall a.
Asset a =>
a
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], (Rate, Int), Rate, Int)
Ast.buildAssumptionPpyDelinqDefRecRate Mortgage
m (Date
lastPayDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) (Maybe AssetDelinquencyAssumption
-> Maybe AssetPrepayAssumption
-> Maybe RecoveryAssumption
-> Maybe ExtraStress
-> AssetPerfAssumption
A.MortgageDeqAssump Maybe AssetDelinquencyAssumption
amd Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams)
        let txns :: [TsRow]
txns = ([TsRow], [TsRow])
-> Recovery
-> Maybe Int
-> Date
-> Dates
-> [Rate]
-> [Rate]
-> [IRate]
-> (Rate, Int, Rate, Int, Period, AmortPlan, Int)
-> ([Recovery], [Recovery], [Recovery])
-> [TsRow]
projectDelinqMortgageFlow ([],[]) Recovery
cb Maybe Int
mbn Date
lastPayDate Dates
cfDates [Rate]
delinqRates [Rate]
ppyRates [IRate]
rateVector 
                                         (Rate
defaultPct,Int
defaultLag,Rate
recoveryRate,Int
recoveryLag,Period
p,AmortPlan
prinPayType,Int
ot) 
                                         (Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
cfDatesLength Recovery
0.0,Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
cfDatesLength Recovery
0.0,Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
cfDatesLength Recovery
0.0)
        let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM)= Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay [TsRow]
txns
        let begBal :: Recovery
begBal = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
        (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (Int, Maybe PrepayPenaltyType) -> CashFlowFrame -> CashFlowFrame
patchPrepayPenaltyFlow (Int
ot,Maybe PrepayPenaltyType
mpn) (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBal,Date
asOfDay, Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)

  -- project defaulted Mortgage    
  projCashflow m :: Mortgage
m@(Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
_) Recovery
cb IRate
cr Int
rt Maybe Int
mbn (Defaulted (Just Date
defaultedDate)) ) 
               Date
asOfDay
               (AssetPerfAssumption
_,AssetDelinqPerfAssumption
_,A.DefaultedRecovery Rate
rr Int
lag [Rate]
timing) Maybe [RateAssumption]
_ =
    let 
      (Dates
emptyDates,Dates
recoveryDates) = Int -> Dates -> (Dates, Dates)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
forall a. Enum a => a -> a
pred Int
lag) (Dates -> (Dates, Dates)) -> Dates -> (Dates, Dates)
forall a b. (a -> b) -> a -> b
$ Date -> Period -> Int -> Dates
genDates Date
defaultedDate Period
p (Int
lag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
timing)
      beforeRecoveryTxn :: [TsRow]
beforeRecoveryTxn = [ Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
d Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 IRate
cr Maybe Int
mbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing | Date
d <- Dates
emptyDates ]
      recoveries :: [Recovery]
recoveries = Recovery -> Rate -> [Rate] -> [Recovery]
calcRecoveriesFromDefault Recovery
cb Rate
rr [Rate]
timing
      txns :: [TsRow]
txns = [ Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
d Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
r Recovery
0 IRate
cr Maybe Int
mbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing | (Date
d,Recovery
r) <- Dates -> [Recovery] -> [(Date, Recovery)]
forall a b. [a] -> [b] -> [(a, b)]
zip Dates
recoveryDates [Recovery]
recoveries ]
      futureTxns :: [TsRow]
futureTxns = CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Inc DateDirection
Future Date
asOfDay ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [TsRow]
beforeRecoveryTxn [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
txns
      begBal :: Recovery
begBal = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
    in 
      (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. b -> Either a b
Right ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBal,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns ,Map CutoffFields Recovery
forall k a. Map k a
Map.empty)

  -- project defaulted adjMortgage with a defaulted Date   
  projCashflow m :: Mortgage
m@(AdjustRateMortgage OriginalInfo
mo ARM
arm Recovery
cb IRate
cr Int
rt Maybe Int
mbn (Defaulted (Just Date
defaultedDate)) ) Date
asOfDay AssetPerf
assumps Maybe [RateAssumption]
mRates
    = Mortgage
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a.
Asset a =>
a
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
projCashflow (OriginalInfo
-> Recovery -> IRate -> Int -> Maybe Int -> Status -> Mortgage
Mortgage OriginalInfo
mo Recovery
cb IRate
cr Int
rt Maybe Int
mbn  (Maybe Date -> Status
Defaulted (Date -> Maybe Date
forall a. a -> Maybe a
Just Date
defaultedDate))) Date
asOfDay AssetPerf
assumps Maybe [RateAssumption]
mRates
  -- project defaulted adjMortgage without a defaulted Date   
  projCashflow m :: Mortgage
m@(AdjustRateMortgage OriginalInfo
_ ARM
_ Recovery
cb IRate
cr Int
rt Maybe Int
mbn (Defaulted Maybe Date
Nothing) ) Date
asOfDay AssetPerf
assumps Maybe [RateAssumption]
_
    = (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. b -> Either a b
Right ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
cb,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [ Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
asOfDay Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 IRate
cr Maybe Int
mbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing] ,Map CutoffFields Recovery
forall k a. Map k a
Map.empty)
  -- project defaulted Mortgage    
  projCashflow m :: Mortgage
m@(Mortgage OriginalInfo
_ Recovery
cb IRate
cr Int
rt Maybe Int
mbn (Defaulted Maybe Date
Nothing) ) Date
asOfDay AssetPerf
assumps Maybe [RateAssumption]
_
    = (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. b -> Either a b
Right ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
cb,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [ Date
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> Recovery
-> IRate
-> Maybe Int
-> Maybe Recovery
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
asOfDay Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 Recovery
0 IRate
cr Maybe Int
mbn Maybe Recovery
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing] ,Map CutoffFields Recovery
forall k a. Map k a
Map.empty)

  -- project current AdjMortgage
  projCashflow m :: Mortgage
m@(AdjustRateMortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
_) ARM
arm Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
Current) 
               Date
asOfDay 
               mars :: AssetPerf
mars@(A.MortgageAssump Maybe AssetDefaultAssumption
amd Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams,AssetDelinqPerfAssumption
_,AssetDefaultedPerfAssumption
_) 
               Maybe [RateAssumption]
mRates =
    let
      ARM Int
initPeriod RateFloor
initCap RateFloor
periodicCap RateFloor
lifeCap RateFloor
lifeFloor = ARM
arm
      passInitPeriod :: Bool
passInitPeriod = (Int
ot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rt) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
initPeriod 
      firstResetDate :: Date
firstResetDate = Date -> Integer -> Date
monthsAfter Date
sd (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Int
forall a. Enum a => a -> a
succ Int
initPeriod))
      (Rate
recoveryRate,Int
recoveryLag) = Maybe RecoveryAssumption -> (Rate, Int)
Ast.getRecoveryLagAndRate Maybe RecoveryAssumption
amr
      Date
lastPayDate:Dates
cfDates = SliceType -> Dates -> Dates
sliceDates (Date -> SliceType
SliceOnAfterKeepPrevious Date
asOfDay)  (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
lastN (Int
rt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Mortgage -> Int -> Dates
forall a. Asset a => a -> Int -> Dates
getPaymentDates Mortgage
m Int
recoveryLag 
      cfDatesLength :: Int
cfDatesLength = Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates -- `debug` (" cf dates >>" ++ show (last_pay_date:cf_dates ))
      rateCurve :: Ts
rateCurve = RateType
-> (ARM, Date, Date, Date, IRate) -> Maybe [RateAssumption] -> Ts
buildARMrates RateType
or (ARM
arm, Date
sd, Date
firstResetDate, Dates -> Date
forall a. HasCallStack => [a] -> a
last Dates
cfDates, Mortgage -> IRate
forall a. Asset a => a -> IRate
getOriginRate Mortgage
m) Maybe [RateAssumption]
mRates
      rateVector :: [IRate]
rateVector = Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational (Rate -> IRate) -> [Rate] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ts -> CutoffType -> Dates -> [Rate]
getValByDates Ts
rateCurve CutoffType
Inc Dates
cfDates -- `debug` ("RateCurve"++ show rate_curve)
      scheduleBalToday :: Recovery
scheduleBalToday = Mortgage -> Maybe [RateAssumption] -> Date -> Recovery
calcScheduleBalaceToday Mortgage
m Maybe [RateAssumption]
mRates Date
asOfDay
      dc :: DayCount
dc = RateType -> DayCount
getDayCount RateType
or
    in
      do 
        ([Rate]
ppyRates,[Rate]
defRates,Rate
recoveryRate,Int
recoveryLag) <- Mortgage
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], Rate, Int)
forall a.
Asset a =>
a
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], Rate, Int)
buildAssumptionPpyDefRecRate Mortgage
m (Date
lastPayDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) (Maybe AssetDefaultAssumption
-> Maybe AssetPrepayAssumption
-> Maybe RecoveryAssumption
-> Maybe ExtraStress
-> AssetPerfAssumption
A.MortgageAssump Maybe AssetDefaultAssumption
amd Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams)
        let remainTerms :: [Int]
remainTerms = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
recoveryLag Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
0..Int
rt]
        let (DList TsRow
txns,Recovery
_,Recovery
_) = (Recovery, Recovery, Date, Maybe Int, AmortPlan, DayCount, IRate,
 Period, Int)
-> (Dates, [Rate], [Rate], [IRate], [Int])
-> (DList TsRow, Recovery, Recovery)
projectMortgageFlow (Recovery
scheduleBalToday, Recovery
cb,Date
lastPayDate,Maybe Int
mbn,AmortPlan
prinPayType,DayCount
dc,IRate
cr,Period
p,Int
ot) (Dates
cfDates, [Rate]
defRates, [Rate]
ppyRates,[IRate]
rateVector,[Int]
remainTerms)
        let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM)= Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay ([TsRow] -> Maybe RecoveryAssumption -> [TsRow]
patchLossRecovery (DList TsRow -> [TsRow]
forall a. DList a -> [a]
DL.toList DList TsRow
txns) Maybe RecoveryAssumption
amr)
        let begBal :: Recovery
begBal = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
        (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (Int, Maybe PrepayPenaltyType) -> CashFlowFrame -> CashFlowFrame
patchPrepayPenaltyFlow (Int
ot,Maybe PrepayPenaltyType
mpn) (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBal,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)
  
  -- project current AdjMortgage with delinq
  projCashflow m :: Mortgage
m@(AdjustRateMortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
_) ARM
arm Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
Current) 
               Date
asOfDay 
               mars :: AssetPerf
mars@(A.MortgageDeqAssump Maybe AssetDelinquencyAssumption
amd Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams,AssetDelinqPerfAssumption
_,AssetDefaultedPerfAssumption
_) 
               Maybe [RateAssumption]
mRates 
    = let
        ARM Int
initPeriod RateFloor
initCap RateFloor
periodicCap RateFloor
lifeCap RateFloor
lifeFloor = ARM
arm
        passInitPeriod :: Bool
passInitPeriod = (Int
ot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rt) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
initPeriod 
        firstResetDate :: Date
firstResetDate = Date -> Integer -> Date
monthsAfter Date
sd (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Int
forall a. Enum a => a -> a
succ Int
initPeriod))
        (Rate
recoveryRate,Int
recoveryLag) = Maybe RecoveryAssumption -> (Rate, Int)
Ast.getRecoveryLagAndRate Maybe RecoveryAssumption
amr
        -- Ast.getDefaultDelinqAssump amd
        Date
lastPayDate:Dates
cfDates = Int -> Dates -> Dates
forall a. Int -> [a] -> [a]
lastN (Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
defaultLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Dates -> Dates) -> Dates -> Dates
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Mortgage -> Int -> Dates
forall a. Asset a => a -> Int -> Dates
getPaymentDates Mortgage
m Int
recoveryLag  
        ([Rate]
_,Int
defaultLag,Rate
defaultPct) = Maybe AssetDelinquencyAssumption -> Dates -> ([Rate], Int, Rate)
Ast.getDefaultDelinqAssump Maybe AssetDelinquencyAssumption
amd Dates
cfDates
        cfDatesLength :: Int
cfDatesLength = Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
cfDates 
        rateCurve :: Ts
rateCurve = RateType
-> (ARM, Date, Date, Date, IRate) -> Maybe [RateAssumption] -> Ts
buildARMrates RateType
or (ARM
arm, Date
sd, Date
firstResetDate, Dates -> Date
forall a. HasCallStack => [a] -> a
last Dates
cfDates, Mortgage -> IRate
forall a. Asset a => a -> IRate
getOriginRate Mortgage
m) Maybe [RateAssumption]
mRates
        rateVector :: [IRate]
rateVector = Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational (Rate -> IRate) -> [Rate] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ts -> CutoffType -> Dates -> [Rate]
getValByDates Ts
rateCurve CutoffType
Inc Dates
cfDates -- `debug` ("RateCurve"++ show rate_curve)                                  
      in
        do
          ([Rate]
ppyRates, [Rate]
delinqRates,(Rate
_,Int
_),Rate
_,Int
_) <- Mortgage
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], (Rate, Int), Rate, Int)
forall a.
Asset a =>
a
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], (Rate, Int), Rate, Int)
Ast.buildAssumptionPpyDelinqDefRecRate Mortgage
m (Date
lastPayDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) (Maybe AssetDelinquencyAssumption
-> Maybe AssetPrepayAssumption
-> Maybe RecoveryAssumption
-> Maybe ExtraStress
-> AssetPerfAssumption
A.MortgageDeqAssump Maybe AssetDelinquencyAssumption
amd Maybe AssetPrepayAssumption
amp Maybe RecoveryAssumption
amr Maybe ExtraStress
ams)
          let txns :: [TsRow]
txns = ([TsRow], [TsRow])
-> Recovery
-> Maybe Int
-> Date
-> Dates
-> [Rate]
-> [Rate]
-> [IRate]
-> (Rate, Int, Rate, Int, Period, AmortPlan, Int)
-> ([Recovery], [Recovery], [Recovery])
-> [TsRow]
projectDelinqMortgageFlow ([],[]) Recovery
cb Maybe Int
mbn Date
lastPayDate Dates
cfDates [Rate]
delinqRates [Rate]
ppyRates [IRate]
rateVector 
                                           (Rate
defaultPct,Int
defaultLag,Rate
recoveryRate,Int
recoveryLag,Period
p,AmortPlan
prinPayType,Int
ot) 
                                           (Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
cfDatesLength Recovery
0.0,Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
cfDatesLength Recovery
0.0,Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
cfDatesLength Recovery
0.0)
          let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM)= Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay [TsRow]
txns 
          let begBal :: Recovery
begBal = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
          (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (CashFlowFrame -> CashFlowFrame) -> CashFlowFrame -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (Int, Maybe PrepayPenaltyType) -> CashFlowFrame -> CashFlowFrame
patchPrepayPenaltyFlow (Int
ot,Maybe PrepayPenaltyType
mpn) (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBal,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)
  
  -- schedule mortgage flow without delinq
  projCashflow m :: Mortgage
m@(ScheduleMortgageFlow Date
begDate [TsRow]
flows DatePattern
dp) Date
asOfDay 
               assumps :: AssetPerf
assumps@(pAssump :: AssetPerfAssumption
pAssump@(A.MortgageAssump Maybe AssetDefaultAssumption
_ Maybe AssetPrepayAssumption
_ Maybe RecoveryAssumption
mRa Maybe ExtraStress
ams ),AssetDelinqPerfAssumption
dAssump,AssetDefaultedPerfAssumption
fAssump) Maybe [RateAssumption]
_
    = let
        begBal :: Recovery
begBal =  TsRow -> Recovery
CF.mflowBegBalance (TsRow -> Recovery) -> TsRow -> Recovery
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
flows 
        endDate :: Date
endDate = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
flows)
        (Rate
recoveryRate,Int
recoveryLag) = Maybe RecoveryAssumption -> (Rate, Int)
Ast.getRecoveryLagAndRate Maybe RecoveryAssumption
mRa
        curveDatesLength :: Int
curveDatesLength =  Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
flows
        extraDates :: Dates
extraDates = DatePattern -> CutoffType -> Date -> Int -> Dates
genSerialDates DatePattern
dp CutoffType
Exc Date
endDate Int
recoveryLag
        cfDates :: Dates
cfDates = (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate (TsRow -> Date) -> [TsRow] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
flows) Dates -> Dates -> Dates
forall a. [a] -> [a] -> [a]
++ Dates
extraDates
      in
        do
          ([Rate]
ppyRates,[Rate]
defRates,Rate
recoveryRate,Int
recoveryLag) <- Mortgage
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], Rate, Int)
forall a.
Asset a =>
a
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], Rate, Int)
buildAssumptionPpyDefRecRate Mortgage
m (Date
begDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) AssetPerfAssumption
pAssump 
          let txns :: [TsRow]
txns = [TsRow]
-> Rate
-> Recovery
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Recovery]
-> [Recovery]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow [] Rate
1.0 Recovery
begBal [TsRow]
flows [Rate]
defRates [Rate]
ppyRates
                                     (Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Recovery
0.0)
                                     (Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Recovery
0.0)
                                     (Int
recoveryLag,Rate
recoveryRate) 
          let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM) = Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay [TsRow]
txns 
          let begBalAfterCutoff :: Recovery
begBalAfterCutoff = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
          (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBalAfterCutoff,Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)
  
  -- schedule mortgage flow WITH delinq
  projCashflow smf :: Mortgage
smf@(ScheduleMortgageFlow Date
begDate [TsRow]
flows DatePattern
dp) Date
asOfDay assumps :: AssetPerf
assumps@(pAssump :: AssetPerfAssumption
pAssump@(A.MortgageDeqAssump Maybe AssetDelinquencyAssumption
_ Maybe AssetPrepayAssumption
_ Maybe RecoveryAssumption
_ Maybe ExtraStress
ams),AssetDelinqPerfAssumption
dAssump,AssetDefaultedPerfAssumption
fAssump) Maybe [RateAssumption]
mRates
    = 
      let
        begBal :: Recovery
begBal =  TsRow -> Recovery
CF.mflowBegBalance (TsRow -> Recovery) -> TsRow -> Recovery
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
flows -- `debug` ("beg date"++show beg_date)
      in
        do
          ([Rate]
ppyRates, [Rate]
delinqRates,(Rate
defaultPct,Int
defaultLag),Rate
recoveryRate,Int
recoveryLag) <- Mortgage
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], (Rate, Int), Rate, Int)
forall a.
Asset a =>
a
-> Dates
-> AssetPerfAssumption
-> Either [Char] ([Rate], [Rate], (Rate, Int), Rate, Int)
Ast.buildAssumptionPpyDelinqDefRecRate Mortgage
smf (Date
begDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:[TsRow] -> Dates
forall ts. TimeSeries ts => [ts] -> Dates
getDates [TsRow]
flows) AssetPerfAssumption
pAssump
          let curveDatesLength :: Int
curveDatesLength = Int
defaultLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
flows -- `debug` ("Length of rates"++show (length delinqRates)++">>"++show (length ppyRates))
          let extraPeriods :: Int
extraPeriods = Int
defaultLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
recoveryLag -- `debug` ("lags "++show defaultLag++">>"++show recoveryLag)
          let endDate :: Date
endDate = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
flows) 
          let extraDates :: Dates
extraDates = DatePattern -> CutoffType -> Date -> Int -> Dates
genSerialDates DatePattern
dp CutoffType
Exc Date
endDate Int
extraPeriods
          let extraFlows :: [TsRow]
extraFlows = [ Date -> TsRow -> TsRow
CF.emptyTsRow Date
d TsRow
r | (Date
d,TsRow
r) <- Dates -> [TsRow] -> [(Date, TsRow)]
forall a b. [a] -> [b] -> [(a, b)]
zip Dates
extraDates (Int -> TsRow -> [TsRow]
forall a. Int -> a -> [a]
replicate Int
extraPeriods ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
flows)) ] 
          let flowWithExtraDates :: [TsRow]
flowWithExtraDates = [TsRow]
flows [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
extraFlows
          let cfDates :: Dates
cfDates = [TsRow] -> Dates
forall ts. TimeSeries ts => [ts] -> Dates
getDates [TsRow]
flowWithExtraDates -- `debug` ("CF dates"++ show flowWithExtraDates)
          let txns :: [TsRow]
txns = ([TsRow], [TsRow])
-> Rate
-> Recovery
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Recovery]
-> [Recovery]
-> [Recovery]
-> (Rate, Int, Rate, Int)
-> [TsRow]
projectScheduleDelinqFlow ([],[]) Rate
1.0 Recovery
begBal [TsRow]
flowWithExtraDates [Rate]
delinqRates [Rate]
ppyRates
                   (Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Recovery
0.0) (Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Recovery
0.0)
                   (Int -> Recovery -> [Recovery]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Recovery
0.0) (Rate
defaultPct,Int
defaultLag,Rate
recoveryRate,Int
recoveryLag)  -- `debug` ("Delinq rates"++ show delinqRates++">>ppy rates"++ show ppyRates)
          let ([TsRow]
futureTxns,Map CutoffFields Recovery
historyM) = Date -> [TsRow] -> ([TsRow], Map CutoffFields Recovery)
CF.cutoffTrs Date
asOfDay [TsRow]
txns 
          let begBalAfterCutoff :: Recovery
begBalAfterCutoff = [TsRow] -> Recovery
CF.buildBegBal [TsRow]
futureTxns
          (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Recovery)
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> (CashFlowFrame, Map CutoffFields Recovery)
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ (Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
ams (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Recovery
begBalAfterCutoff, Date
asOfDay,Maybe Recovery
forall a. Maybe a
Nothing) [TsRow]
futureTxns) ,Map CutoffFields Recovery
historyM)
  
  projCashflow Mortgage
a Date
b AssetPerf
c Maybe [RateAssumption]
d = [Char] -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. a -> Either a b
Left ([Char]
 -> Either [Char] (CashFlowFrame, Map CutoffFields Recovery))
-> [Char]
-> Either [Char] (CashFlowFrame, Map CutoffFields Recovery)
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to match when proj mortgage with assumption >>" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Mortgage -> [Char]
forall a. Show a => a -> [Char]
show Mortgage
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Date -> [Char]
forall a. Show a => a -> [Char]
show Date
b [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AssetPerf -> [Char]
forall a. Show a => a -> [Char]
show AssetPerf
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe [RateAssumption] -> [Char]
forall a. Show a => a -> [Char]
show Maybe [RateAssumption]
d

  getBorrowerNum :: Mortgage -> Int
getBorrowerNum m :: Mortgage
m@(Mortgage OriginalInfo
_ Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
_ ) = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mbn
  getBorrowerNum m :: Mortgage
m@(AdjustRateMortgage OriginalInfo
_ ARM
_ Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
_ ) = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mbn

  splitWith :: Mortgage -> [Rate] -> [Mortgage]
splitWith (Mortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
st ) [Rate]
rs 
    = [ OriginalInfo
-> Recovery -> IRate -> Int -> Maybe Int -> Status -> Mortgage
Mortgage (Recovery
-> RateType
-> Int
-> Period
-> Date
-> AmortPlan
-> Maybe PrepayPenaltyType
-> Maybe Obligor
-> OriginalInfo
MortgageOriginalInfo (Recovery -> Rate -> Recovery
mulBR Recovery
ob Rate
ratio) RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) (Recovery -> Rate -> Recovery
mulBR Recovery
cb Rate
ratio) IRate
cr Int
rt Maybe Int
mbn Status
st 
       | Rate
ratio <- [Rate]
rs ]
  
  splitWith (AdjustRateMortgage (MortgageOriginalInfo Recovery
ob RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) ARM
arm Recovery
cb IRate
cr Int
rt Maybe Int
mbn Status
st ) [Rate]
rs 
    = [ OriginalInfo
-> ARM
-> Recovery
-> IRate
-> Int
-> Maybe Int
-> Status
-> Mortgage
AdjustRateMortgage (Recovery
-> RateType
-> Int
-> Period
-> Date
-> AmortPlan
-> Maybe PrepayPenaltyType
-> Maybe Obligor
-> OriginalInfo
MortgageOriginalInfo (Recovery -> Rate -> Recovery
mulBR Recovery
ob Rate
ratio) RateType
or Int
ot Period
p Date
sd AmortPlan
prinPayType Maybe PrepayPenaltyType
mpn Maybe Obligor
obr) ARM
arm (Recovery -> Rate -> Recovery
mulBR Recovery
cb Rate
ratio) IRate
cr Int
rt Maybe Int
mbn Status
st 
       | Rate
ratio <- [Rate]
rs ]