{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DataKinds       #-}

module Cashflow (CashFlowFrame(..),Principals,Interests,Amount
                ,combine,mergePoolCf,sumTsCF,tsSetLoss,tsSetRecovery
                ,sizeCashFlowFrame,aggTsByDates,emptyCashFlowFrame
                ,mflowInterest,mflowPrincipal,mflowRecovery,mflowPrepayment
                ,mflowRental,mflowRate,sumPoolFlow,splitTrs,aggregateTsByDate
                ,mflowDefault,mflowLoss
                ,getDatesCashFlowFrame
                ,lookupSource,lookupSourceM,combineTss
                ,mflowBegBalance,tsDefaultBal
                ,mflowBorrowerNum,mflowPrepaymentPenalty,tsRowBalance
                ,emptyTsRow,mflowAmortAmount
                ,tsTotalCash, setPrepaymentPenalty, setPrepaymentPenaltyFlow
                ,getDate,getTxnLatestAsOf,totalPrincipal
                ,mflowWeightAverageBalance,tsDate
                ,totalLoss,totalDefault,totalRecovery,firstDate
                ,shiftCfToStartDate,cfInsertHead,buildBegTsRow,insertBegTsRow
                ,tsCumDefaultBal,tsCumDelinqBal,tsCumLossBal,tsCumRecoveriesBal
                ,TsRow(..),cfAt,cutoffTrs,patchCumulative,extendTxns,dropTailEmptyTxns
                ,cashflowTxn,clawbackInt,scaleTsRow,mflowFeePaid, currentCumulativeStat, patchCumulativeAtInit
                ,mergeCf,buildStartTsRow
                ,txnCumulativeStats,consolidateCashFlow, cfBeginStatus, getBegBalCashFlowFrame
                ,splitCashFlowFrameByDate, mergePoolCf2, buildBegBal, extendCashFlow, patchBalance
                ,splitPoolCashflowByDate
                ,getAllDatesCashFlowFrame,splitCf, cutoffCashflow
                ,AssetCashflow,PoolCashflow
                ,emptyCashflow,isEmptyRow2
                ) where

import Data.Time (Day)
import Data.Fixed
import Lib (weightedBy,toDate,getIntervalFactors,daysBetween,paySeqLiabilitiesAmt)
import Util (mulBR,mulBInt,mulIR,lastOf)
import DateUtil ( splitByDate )
import Types
import qualified Data.Map as Map
import qualified Data.Time as T
import qualified Data.List as L
import Data.Maybe 

import Data.Aeson hiding (json)
import Language.Haskell.TH
import GHC.Generics
import Data.Aeson.TH
import Data.Aeson.Types
import Text.Printf

import Debug.Trace
import qualified Control.Lens as Map
import Control.Applicative (liftA2)
import Data.OpenApi (HasPatch(patch), HasXml (xml))
import Control.DeepSeq (NFData,rnf)
import Data.Text.Internal.Encoding.Fusion (streamUtf16BE)

import qualified Text.Tabular as TT
import qualified Text.Tabular.AsciiArt as A
import Control.Lens hiding (element)
import Control.Lens.TH

debug :: c -> String -> c
debug = (String -> c -> c) -> c -> String -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> c -> c
forall a. String -> a -> a
trace

type Delinquent = Balance
type Amounts = [Float]
type Principals = [Principal]
type Interests = [Interest]
type Prepayments = [Prepayment]
type Recoveries = [Recovery]
type Rates = [Rate]

type CumulativeStat = (CumPrincipal,CumPrepay,CumDelinq,CumDefault,CumRecovery,CumLoss)
type AssetCashflow = CashFlowFrame
type PoolCashflow = (AssetCashflow, Maybe [AssetCashflow])
emptyCashflow :: CashFlowFrame
emptyCashflow = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame (Principal
0,Date
epocDate,Maybe Principal
forall a. Maybe a
Nothing) []


instance Monoid CashFlowFrame where
  mempty :: CashFlowFrame
mempty = CashFlowFrame
emptyCashflow

instance Semigroup CashFlowFrame where
  CashFlowFrame (Principal
begBal1, Date
begDate1, Maybe Principal
mAccInt1) [TsRow]
ts1 <> :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
<> CashFlowFrame (Principal
begBal2, Date
begDate2, Maybe Principal
mAccInt2) [TsRow]
ts2 
    = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame (Principal
begBal1,Date
begDate1,Maybe Principal
mAccInt1) ([TsRow]
ts1 [TsRow] -> [TsRow] -> [TsRow]
forall a. Semigroup a => a -> a -> a
<> [TsRow]
ts2)

opStats :: (Balance -> Balance -> Balance) -> Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat
opStats :: (Principal -> Principal -> Principal)
-> Maybe CumulativeStat
-> Maybe CumulativeStat
-> Maybe CumulativeStat
opStats Principal -> Principal -> Principal
op (Just (Principal
a1,Principal
b1,Principal
c1,Principal
d1,Principal
e1,Principal
f1)) (Just (Principal
a2,Principal
b2,Principal
c3,Principal
d2,Principal
e2,Principal
f2)) = CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just (Principal -> Principal -> Principal
op Principal
a1 Principal
a2,Principal -> Principal -> Principal
op Principal
b1 Principal
b2,Principal -> Principal -> Principal
op Principal
c1 Principal
c3,Principal -> Principal -> Principal
op Principal
d1 Principal
d2,Principal -> Principal -> Principal
op Principal
e1 Principal
e2,Principal -> Principal -> Principal
op Principal
f1 Principal
f2)
opStats Principal -> Principal -> Principal
op Maybe CumulativeStat
Nothing Maybe CumulativeStat
Nothing = Maybe CumulativeStat
forall a. Maybe a
Nothing
opStats Principal -> Principal -> Principal
op (Just CumulativeStat
a) Maybe CumulativeStat
Nothing = CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just CumulativeStat
a
opStats Principal -> Principal -> Principal
op Maybe CumulativeStat
Nothing (Just CumulativeStat
a) = CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just CumulativeStat
a

sumStats :: Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat
-- sumStats (a1,b1,c1,d1,e1,f1) (a2,b2,c3,d2,e2,f2) = (a1+a2,b1+b2,c1+c3,d1+d2,e1+e2,f1+f2)
sumStats :: Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
s1 Maybe CumulativeStat
s2 = (Principal -> Principal -> Principal)
-> Maybe CumulativeStat
-> Maybe CumulativeStat
-> Maybe CumulativeStat
opStats Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) Maybe CumulativeStat
s1 Maybe CumulativeStat
s2

subStats :: Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat
-- subStats (a1,b1,c1,d1,e1,f1) (a2,b2,c3,d2,e2,f2) = (a1-a2,b1-b2,c1-c3,d1-d2,e1-e2,f1-f2)
subStats :: Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
subStats Maybe CumulativeStat
s1 Maybe CumulativeStat
s2 = (Principal -> Principal -> Principal)
-> Maybe CumulativeStat
-> Maybe CumulativeStat
-> Maybe CumulativeStat
opStats (-) Maybe CumulativeStat
s1 Maybe CumulativeStat
s2

maxStats :: Maybe CumulativeStat -> Maybe CumulativeStat -> Maybe CumulativeStat
-- maxStats (a1,b1,c1,d1,e1,f1) (a2,b2,c3,d2,e2,f2) = (max a1 a2,max b1 b2,max c1 c3,max d1 d2,max e1 e2,max f1 f2)
maxStats :: Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
maxStats Maybe CumulativeStat
s1 Maybe CumulativeStat
s2 = (Principal -> Principal -> Principal)
-> Maybe CumulativeStat
-> Maybe CumulativeStat
-> Maybe CumulativeStat
opStats Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
max Maybe CumulativeStat
s1 Maybe CumulativeStat
s2

splitStats :: Rational -> CumulativeStat -> CumulativeStat
splitStats :: Rational -> CumulativeStat -> CumulativeStat
splitStats Rational
r st1 :: CumulativeStat
st1@(Principal
a1,Principal
b1,Principal
c1,Principal
d1,Principal
e1,Principal
f1) = ((Principal -> Rational -> Principal
`mulBR` Rational
r) Principal
a1,(Principal -> Rational -> Principal
`mulBR` Rational
r) Principal
b1,(Principal -> Rational -> Principal
`mulBR` Rational
r) Principal
c1,(Principal -> Rational -> Principal
`mulBR` Rational
r) Principal
d1,(Principal -> Rational -> Principal
`mulBR` Rational
r) Principal
e1,(Principal -> Rational -> Principal
`mulBR` Rational
r) Principal
f1)

type Depreciation = Balance
type NewDepreciation = Balance 
type AccuredFee = Balance
type FeePaid = Balance

startOfTime :: Date
startOfTime = Integer -> Int -> Int -> Date
T.fromGregorian Integer
1900 Int
1 Int
1

data TsRow = CashFlow Date Amount
           | BondFlow Date Balance Principal Interest
           | MortgageFlow Date Balance Principal Interest Prepayment Default Recovery Loss IRate (Maybe BorrowerNum) (Maybe PrepaymentPenalty) (Maybe CumulativeStat)
           | MortgageDelinqFlow Date Balance Principal Interest Prepayment Delinquent Default Recovery Loss IRate (Maybe BorrowerNum) (Maybe PrepaymentPenalty) (Maybe CumulativeStat)
           | LoanFlow Date Balance Principal Interest Prepayment Default Recovery Loss IRate (Maybe CumulativeStat)
           | LeaseFlow Date Balance Rental Default
           | FixedFlow Date Balance NewDepreciation Depreciation Balance Balance -- unit cash 
           | ReceivableFlow Date Balance AccuredFee Principal FeePaid Default Recovery Loss (Maybe CumulativeStat) 
           deriving(Int -> TsRow -> ShowS
[TsRow] -> ShowS
TsRow -> String
(Int -> TsRow -> ShowS)
-> (TsRow -> String) -> ([TsRow] -> ShowS) -> Show TsRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TsRow -> ShowS
showsPrec :: Int -> TsRow -> ShowS
$cshow :: TsRow -> String
show :: TsRow -> String
$cshowList :: [TsRow] -> ShowS
showList :: [TsRow] -> ShowS
Show,TsRow -> TsRow -> Bool
(TsRow -> TsRow -> Bool) -> (TsRow -> TsRow -> Bool) -> Eq TsRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TsRow -> TsRow -> Bool
== :: TsRow -> TsRow -> Bool
$c/= :: TsRow -> TsRow -> Bool
/= :: TsRow -> TsRow -> Bool
Eq,Eq TsRow
Eq TsRow =>
(TsRow -> TsRow -> Ordering)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> TsRow)
-> (TsRow -> TsRow -> TsRow)
-> Ord TsRow
TsRow -> TsRow -> Bool
TsRow -> TsRow -> Ordering
TsRow -> TsRow -> TsRow
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TsRow -> TsRow -> Ordering
compare :: TsRow -> TsRow -> Ordering
$c< :: TsRow -> TsRow -> Bool
< :: TsRow -> TsRow -> Bool
$c<= :: TsRow -> TsRow -> Bool
<= :: TsRow -> TsRow -> Bool
$c> :: TsRow -> TsRow -> Bool
> :: TsRow -> TsRow -> Bool
$c>= :: TsRow -> TsRow -> Bool
>= :: TsRow -> TsRow -> Bool
$cmax :: TsRow -> TsRow -> TsRow
max :: TsRow -> TsRow -> TsRow
$cmin :: TsRow -> TsRow -> TsRow
min :: TsRow -> TsRow -> TsRow
Ord,(forall x. TsRow -> Rep TsRow x)
-> (forall x. Rep TsRow x -> TsRow) -> Generic TsRow
forall x. Rep TsRow x -> TsRow
forall x. TsRow -> Rep TsRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TsRow -> Rep TsRow x
from :: forall x. TsRow -> Rep TsRow x
$cto :: forall x. Rep TsRow x -> TsRow
to :: forall x. Rep TsRow x -> TsRow
Generic,TsRow -> ()
(TsRow -> ()) -> NFData TsRow
forall a. (a -> ()) -> NFData a
$crnf :: TsRow -> ()
rnf :: TsRow -> ()
NFData)

instance Semigroup TsRow where 
  CashFlow Date
d1 Principal
a1 <> :: TsRow -> TsRow -> TsRow
<> (CashFlow Date
d2 Principal
a2) = Date -> Principal -> TsRow
CashFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
a1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
a2)
  BondFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 <> (BondFlow Date
d2 Principal
b2 Principal
p2 Principal
i2) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2)
  MortgageFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1 <> MortgageFlow Date
d2 Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2
    = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2])))  ((Int -> Int -> Int) -> Maybe Int -> Maybe Int -> Maybe Int
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Maybe Int
mbn1 Maybe Int
mbn2)   ((Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe Principal -> Maybe Principal
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) Maybe Principal
pn1 Maybe Principal
pn2)  (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)
  MortgageDelinqFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
delinq1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1 <> MortgageDelinqFlow Date
d2 Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
delinq2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2
    = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
delinq1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
delinq2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) ((Int -> Int -> Int) -> Maybe Int -> Maybe Int -> Maybe Int
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Maybe Int
mbn1 Maybe Int
mbn2) ((Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe Principal -> Maybe Principal
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) Maybe Principal
pn1 Maybe Principal
pn2) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)
  LoanFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe CumulativeStat
st1 <> LoanFlow Date
d2 Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe CumulativeStat
st2
    = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)
  LeaseFlow Date
d1 Principal
b1 Principal
r1 Principal
def1 <> LeaseFlow Date
d2 Principal
b2 Principal
r2 Principal
def2
    = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
r1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
r2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2)
  FixedFlow Date
d1 Principal
b1 Principal
ndep1 Principal
dep1 Principal
c1 Principal
a1 <> FixedFlow Date
d2 Principal
b2 Principal
ndep2 Principal
dep2 Principal
c2 Principal
a2 
    = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
ndep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
ndep2) (Principal
dep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
dep2) (Principal
c1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
c2) (Principal
a1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
a2)
  ReceivableFlow Date
d1 Principal
b1 Principal
af1 Principal
p1 Principal
fp1 Principal
def1 Principal
rec1 Principal
los1 Maybe CumulativeStat
st1 <> ReceivableFlow Date
d2 Principal
b2 Principal
af2 Principal
p2 Principal
fp2 Principal
def2 Principal
rec2 Principal
los2 Maybe CumulativeStat
st2
    = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow (Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d1 Date
d2) (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
af1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
af2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
fp1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
fp2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
los2) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)
  TsRow
a <> TsRow
b = String -> TsRow
forall a. HasCallStack => String -> a
error (String -> TsRow) -> String -> TsRow
forall a b. (a -> b) -> a -> b
$ String
"TsRow Semigroup not supported "String -> ShowS
forall a. [a] -> [a] -> [a]
++TsRow -> String
forall a. Show a => a -> String
show TsRow
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++TsRow -> String
forall a. Show a => a -> String
show TsRow
b


instance TimeSeries TsRow where 
    getDate :: TsRow -> Date
getDate (CashFlow Date
x Principal
_) = Date
x
    getDate (BondFlow Date
x  Principal
_ Principal
_ Principal
_) = Date
x
    getDate (MortgageFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Date
x
    getDate (MortgageDelinqFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Date
x
    getDate (LoanFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Date
x
    getDate (LeaseFlow Date
x Principal
_ Principal
_ Principal
_) = Date
x
    getDate (FixedFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ ) = Date
x
    getDate (ReceivableFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Maybe CumulativeStat
_) = Date
x


scaleTsRow :: Rational -> TsRow -> TsRow
scaleTsRow :: Rational -> TsRow -> TsRow
scaleTsRow Rational
r (CashFlow Date
d Principal
a) = Date -> Principal -> TsRow
CashFlow Date
d (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
a)
scaleTsRow Rational
r (BondFlow Date
d Principal
b Principal
p Principal
i) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
d (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
b) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
p) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
i)
scaleTsRow Rational
r (MortgageFlow Date
d Principal
b Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pp Maybe CumulativeStat
st) 
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d 
     (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
b) 
     (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
p) 
     (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
i) 
     (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
prep) 
     (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
def) 
     (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
rec) 
     (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
los) 
     IRate
rat 
     Maybe Int
mbn 
     Maybe Principal
pp 
     (Rational -> CumulativeStat -> CumulativeStat
splitStats Rational
r (CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> Maybe CumulativeStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CumulativeStat
st)
scaleTsRow Rational
r (MortgageDelinqFlow Date
d Principal
b Principal
p Principal
i Principal
prep Principal
delinq Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pp Maybe CumulativeStat
st) 
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d 
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
b)
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
p)
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
i)
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
prep)
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
delinq)
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
def) 
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
rec) 
      (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
los) 
      IRate
rat 
      Maybe Int
mbn 
      Maybe Principal
pp
      (Rational -> CumulativeStat -> CumulativeStat
splitStats Rational
r (CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> Maybe CumulativeStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CumulativeStat
st)
scaleTsRow Rational
r (LoanFlow Date
d Principal
b Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe CumulativeStat
st) 
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
d (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
b) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
p) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
i) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
prep) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
def) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
rec) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
los) IRate
rat ((Rational -> CumulativeStat -> CumulativeStat
splitStats Rational
r) (CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> Maybe CumulativeStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CumulativeStat
st)
scaleTsRow Rational
r (LeaseFlow Date
d Principal
b Principal
rental Principal
def) = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
d (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
b) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
rental) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
def)
scaleTsRow Rational
r (FixedFlow Date
d Principal
b Principal
ndep Principal
dep Principal
c Principal
a) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
d (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
b) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
ndep) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
dep) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
c) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
a)
scaleTsRow Rational
r (ReceivableFlow Date
d Principal
b Principal
af Principal
p Principal
fp Principal
def Principal
rec Principal
los Maybe CumulativeStat
st) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
d (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
b) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
af) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
p) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
fp) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
def) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
rec) (Rational -> Principal
forall a. Fractional a => Rational -> a
fromRational Rational
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
* Principal
los) ((Rational -> CumulativeStat -> CumulativeStat
splitStats Rational
r) (CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> Maybe CumulativeStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CumulativeStat
st)


type BeginBalance = Balance
type AccuredInterest = Maybe Balance
type BeginDate = Date
type BeginStatus = (BeginBalance, BeginDate, AccuredInterest)

data CashFlowFrame = CashFlowFrame BeginStatus [TsRow]
                   | MultiCashFlowFrame (Map.Map String [CashFlowFrame])
                   deriving (CashFlowFrame -> CashFlowFrame -> Bool
(CashFlowFrame -> CashFlowFrame -> Bool)
-> (CashFlowFrame -> CashFlowFrame -> Bool) -> Eq CashFlowFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CashFlowFrame -> CashFlowFrame -> Bool
== :: CashFlowFrame -> CashFlowFrame -> Bool
$c/= :: CashFlowFrame -> CashFlowFrame -> Bool
/= :: CashFlowFrame -> CashFlowFrame -> Bool
Eq,(forall x. CashFlowFrame -> Rep CashFlowFrame x)
-> (forall x. Rep CashFlowFrame x -> CashFlowFrame)
-> Generic CashFlowFrame
forall x. Rep CashFlowFrame x -> CashFlowFrame
forall x. CashFlowFrame -> Rep CashFlowFrame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CashFlowFrame -> Rep CashFlowFrame x
from :: forall x. CashFlowFrame -> Rep CashFlowFrame x
$cto :: forall x. Rep CashFlowFrame x -> CashFlowFrame
to :: forall x. Rep CashFlowFrame x -> CashFlowFrame
Generic,Eq CashFlowFrame
Eq CashFlowFrame =>
(CashFlowFrame -> CashFlowFrame -> Ordering)
-> (CashFlowFrame -> CashFlowFrame -> Bool)
-> (CashFlowFrame -> CashFlowFrame -> Bool)
-> (CashFlowFrame -> CashFlowFrame -> Bool)
-> (CashFlowFrame -> CashFlowFrame -> Bool)
-> (CashFlowFrame -> CashFlowFrame -> CashFlowFrame)
-> (CashFlowFrame -> CashFlowFrame -> CashFlowFrame)
-> Ord CashFlowFrame
CashFlowFrame -> CashFlowFrame -> Bool
CashFlowFrame -> CashFlowFrame -> Ordering
CashFlowFrame -> CashFlowFrame -> CashFlowFrame
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CashFlowFrame -> CashFlowFrame -> Ordering
compare :: CashFlowFrame -> CashFlowFrame -> Ordering
$c< :: CashFlowFrame -> CashFlowFrame -> Bool
< :: CashFlowFrame -> CashFlowFrame -> Bool
$c<= :: CashFlowFrame -> CashFlowFrame -> Bool
<= :: CashFlowFrame -> CashFlowFrame -> Bool
$c> :: CashFlowFrame -> CashFlowFrame -> Bool
> :: CashFlowFrame -> CashFlowFrame -> Bool
$c>= :: CashFlowFrame -> CashFlowFrame -> Bool
>= :: CashFlowFrame -> CashFlowFrame -> Bool
$cmax :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
max :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
$cmin :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
min :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
Ord)

cfBeginStatus :: Lens' CashFlowFrame BeginStatus
cfBeginStatus :: Lens' CashFlowFrame BeginStatus
cfBeginStatus = (CashFlowFrame -> BeginStatus)
-> (CashFlowFrame -> BeginStatus -> CashFlowFrame)
-> Lens' CashFlowFrame BeginStatus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CashFlowFrame -> BeginStatus
getter CashFlowFrame -> BeginStatus -> CashFlowFrame
setter
  where 
    getter :: CashFlowFrame -> BeginStatus
getter (CashFlowFrame BeginStatus
st [TsRow]
_) = BeginStatus
st
    setter :: CashFlowFrame -> BeginStatus -> CashFlowFrame
setter (CashFlowFrame BeginStatus
_ [TsRow]
tsRows) BeginStatus
st = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st [TsRow]
tsRows


instance Show CashFlowFrame where
  show :: CashFlowFrame -> String
show (CashFlowFrame BeginStatus
st []) = String
"Empty CashflowFrame"String -> ShowS
forall a. [a] -> [a] -> [a]
++ BeginStatus -> String
forall a. Show a => a -> String
show BeginStatus
st
  -- show (CashFlowFrame st txns) = concat $ L.intersperse "\n" [ show txn | txn <- txns ]
  show (CashFlowFrame BeginStatus
st [TsRow]
txns) = 
    let 
        ds :: [String]
ds = [ Date -> String
forall a. Show a => a -> String
show Date
d | Date
d <- [TsRow] -> [Date]
forall ts. TimeSeries ts => [ts] -> [Date]
getDates [TsRow]
txns]
        rowHeader :: [Header String]
rowHeader = [String -> Header String
forall h. h -> Header h
TT.Header String
h | String
h <- [String]
ds ]
        getCs :: TsRow -> [String]
getCs (CashFlow {}) = [String
"Amount"]
        getCs (BondFlow {}) = [String
"Balance", String
"Principal", String
"Interest"]
        getCs (MortgageFlow {}) = [String
"Balance", String
"Principal", String
"Interest", String
"Prepayment", String
"Default", String
"Recovery", String
"Loss", String
"IRate", String
"BorrowerNum", String
"PrepaymentPenalty", String
"CumulativeStat"]
        getCs (MortgageDelinqFlow {}) = [ String
"Balance", String
"Principal", String
"Interest", String
"Prepayment", String
"Delinquent", String
"Default", String
"Recovery", String
"Loss", String
"IRate", String
"BorrowerNum", String
"PrepaymentPenalty", String
"CumulativeStat"]
        getCs (LoanFlow {}) = [String
"Balance", String
"Principal", String
"Interest", String
"Prepayment", String
"Default", String
"Recovery", String
"Loss", String
"IRate", String
"CumulativeStat"]
        getCs (LeaseFlow {}) = [ String
"Balance", String
"Rental", String
"Default"]
        getCs (FixedFlow {}) = [ String
"Balance", String
"NewDepreciation", String
"Depreciation", String
"Balance", String
"Amount"]
        getCs (ReceivableFlow {}) = [ String
"Balance", String
"AccuredFee", String
"Principal", String
"FeePaid", String
"Default", String
"Recovery", String
"Loss", String
"CumulativeStat"]
        colHeader :: [Header String]
colHeader = [String -> Header String
forall h. h -> Header h
TT.Header String
c | String
c <- TsRow -> [String]
getCs ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
txns) ]
        getRs :: TsRow -> [String]
getRs (CashFlow Date
d Principal
a) = [Principal -> String
forall a. Show a => a -> String
show Principal
a]
        getRs (BondFlow Date
d Principal
b Principal
p Principal
i) = [ Principal -> String
forall a. Show a => a -> String
show Principal
b, Principal -> String
forall a. Show a => a -> String
show Principal
p, Principal -> String
forall a. Show a => a -> String
show Principal
i]
        getRs (MortgageFlow Date
d Principal
b Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pp Maybe CumulativeStat
st) = [ Principal -> String
forall a. Show a => a -> String
show Principal
b, Principal -> String
forall a. Show a => a -> String
show Principal
p, Principal -> String
forall a. Show a => a -> String
show Principal
i, Principal -> String
forall a. Show a => a -> String
show Principal
prep, Principal -> String
forall a. Show a => a -> String
show Principal
def, Principal -> String
forall a. Show a => a -> String
show Principal
rec, Principal -> String
forall a. Show a => a -> String
show Principal
los, IRate -> String
forall a. Show a => a -> String
show IRate
rat, Maybe Int -> String
forall a. Show a => a -> String
show Maybe Int
mbn, Maybe Principal -> String
forall a. Show a => a -> String
show Maybe Principal
pp, Maybe CumulativeStat -> String
forall a. Show a => a -> String
show Maybe CumulativeStat
st]
        getRs (MortgageDelinqFlow Date
d Principal
b Principal
p Principal
i Principal
prep Principal
delinq Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pp Maybe CumulativeStat
st) = [ Principal -> String
forall a. Show a => a -> String
show Principal
b, Principal -> String
forall a. Show a => a -> String
show Principal
p, Principal -> String
forall a. Show a => a -> String
show Principal
i, Principal -> String
forall a. Show a => a -> String
show Principal
prep, Principal -> String
forall a. Show a => a -> String
show Principal
delinq, Principal -> String
forall a. Show a => a -> String
show Principal
def, Principal -> String
forall a. Show a => a -> String
show Principal
rec, Principal -> String
forall a. Show a => a -> String
show Principal
los, IRate -> String
forall a. Show a => a -> String
show IRate
rat, Maybe Int -> String
forall a. Show a => a -> String
show Maybe Int
mbn, Maybe Principal -> String
forall a. Show a => a -> String
show Maybe Principal
pp, Maybe CumulativeStat -> String
forall a. Show a => a -> String
show Maybe CumulativeStat
st]
        getRs (LoanFlow Date
d Principal
b Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe CumulativeStat
st) = [ Principal -> String
forall a. Show a => a -> String
show Principal
b, Principal -> String
forall a. Show a => a -> String
show Principal
p, Principal -> String
forall a. Show a => a -> String
show Principal
i, Principal -> String
forall a. Show a => a -> String
show Principal
prep, Principal -> String
forall a. Show a => a -> String
show Principal
def, Principal -> String
forall a. Show a => a -> String
show Principal
rec, Principal -> String
forall a. Show a => a -> String
show Principal
los, IRate -> String
forall a. Show a => a -> String
show IRate
rat, Maybe CumulativeStat -> String
forall a. Show a => a -> String
show Maybe CumulativeStat
st]
        getRs (LeaseFlow Date
d Principal
b Principal
r Principal
def) = [ Principal -> String
forall a. Show a => a -> String
show Principal
b, Principal -> String
forall a. Show a => a -> String
show Principal
r, Principal -> String
forall a. Show a => a -> String
show Principal
def]
        getRs (FixedFlow Date
d Principal
b Principal
ndep Principal
dep Principal
c Principal
a) = [ Principal -> String
forall a. Show a => a -> String
show Principal
b, Principal -> String
forall a. Show a => a -> String
show Principal
ndep, Principal -> String
forall a. Show a => a -> String
show Principal
dep, Principal -> String
forall a. Show a => a -> String
show Principal
c, Principal -> String
forall a. Show a => a -> String
show Principal
a]
        getRs (ReceivableFlow Date
d Principal
b Principal
af Principal
p Principal
fp Principal
def Principal
rec Principal
los Maybe CumulativeStat
st) = [ Principal -> String
forall a. Show a => a -> String
show Principal
b, Principal -> String
forall a. Show a => a -> String
show Principal
af, Principal -> String
forall a. Show a => a -> String
show Principal
p, Principal -> String
forall a. Show a => a -> String
show Principal
fp, Principal -> String
forall a. Show a => a -> String
show Principal
def, Principal -> String
forall a. Show a => a -> String
show Principal
rec, Principal -> String
forall a. Show a => a -> String
show Principal
los, Maybe CumulativeStat -> String
forall a. Show a => a -> String
show Maybe CumulativeStat
st]
        values :: [[String]]
values = [ TsRow -> [String]
getRs TsRow
txn  | TsRow
txn <- [TsRow]
txns ]
        tbl :: Table String String String
tbl = Header String
-> Header String -> [[String]] -> Table String String String
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
TT.Table (Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
TT.Group Properties
TT.SingleLine [Header String]
rowHeader) (Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
TT.Group Properties
TT.SingleLine [Header String]
colHeader) [[String]]
values
    in 
        BeginStatus -> String
forall a. Show a => a -> String
show BeginStatus
st String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS -> ShowS -> ShowS -> Table String String String -> String
forall rh ch a.
(rh -> String)
-> (ch -> String) -> (a -> String) -> Table rh ch a -> String
A.render ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id Table String String String
tbl

instance NFData CashFlowFrame where 
  rnf :: CashFlowFrame -> ()
rnf (CashFlowFrame BeginStatus
st [TsRow]
txns) = BeginStatus -> ()
forall a. NFData a => a -> ()
rnf BeginStatus
st () -> () -> ()
forall a b. a -> b -> b
`seq` [TsRow] -> ()
forall a. NFData a => a -> ()
rnf [TsRow]
txns
  rnf (MultiCashFlowFrame Map String [CashFlowFrame]
m) = Map String [CashFlowFrame] -> ()
forall a. NFData a => a -> ()
rnf Map String [CashFlowFrame]
m

sizeCashFlowFrame :: CashFlowFrame -> Int
sizeCashFlowFrame :: CashFlowFrame -> Int
sizeCashFlowFrame (CashFlowFrame BeginStatus
_ [TsRow]
ts) = [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
ts

emptyCashFlowFrame :: CashFlowFrame -> Bool 
emptyCashFlowFrame :: CashFlowFrame -> Bool
emptyCashFlowFrame (CashFlowFrame BeginStatus
_ []) = Bool
True
emptyCashFlowFrame (CashFlowFrame BeginStatus
_ [TsRow]
_) = Bool
False

getDatesCashFlowFrame :: CashFlowFrame -> [Date]
getDatesCashFlowFrame :: CashFlowFrame -> [Date]
getDatesCashFlowFrame (CashFlowFrame BeginStatus
_ [TsRow]
ts) = [TsRow] -> [Date]
forall ts. TimeSeries ts => [ts] -> [Date]
getDates [TsRow]
ts

getAllDatesCashFlowFrame :: CashFlowFrame -> [Date]
getAllDatesCashFlowFrame :: CashFlowFrame -> [Date]
getAllDatesCashFlowFrame (CashFlowFrame (Principal
_,Date
d,Maybe Principal
_) [TsRow]
ts) = Date
d Date -> [Date] -> [Date]
forall a. a -> [a] -> [a]
: [TsRow] -> [Date]
forall ts. TimeSeries ts => [ts] -> [Date]
getDates [TsRow]
ts

getBegBalCashFlowFrame :: CashFlowFrame -> Balance
getBegBalCashFlowFrame :: CashFlowFrame -> Principal
getBegBalCashFlowFrame (CashFlowFrame BeginStatus
_ []) = Principal
0
getBegBalCashFlowFrame (CashFlowFrame BeginStatus
_ (TsRow
cf:[TsRow]
cfs)) = TsRow -> Principal
mflowBegBalance TsRow
cf

cfAt :: CashFlowFrame -> Int -> Maybe TsRow
cfAt :: CashFlowFrame -> Int -> Maybe TsRow
cfAt (CashFlowFrame BeginStatus
_ [TsRow]
trs) Int
idx 
  | (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) Bool -> Bool -> Bool
|| (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
trs) = Maybe TsRow
forall a. Maybe a
Nothing
  | Bool
otherwise = TsRow -> Maybe TsRow
forall a. a -> Maybe a
Just ([TsRow]
trs[TsRow] -> Int -> TsRow
forall a. HasCallStack => [a] -> Int -> a
!!Int
idx)

cfInsertHead :: TsRow -> CashFlowFrame -> CashFlowFrame
cfInsertHead :: TsRow -> CashFlowFrame -> CashFlowFrame
cfInsertHead TsRow
tr (CashFlowFrame BeginStatus
st [TsRow]
trs) = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs


splitCashFlowFrameByDate :: CashFlowFrame -> Date -> SplitType  -> (CashFlowFrame,CashFlowFrame)
splitCashFlowFrameByDate :: CashFlowFrame
-> Date -> SplitType -> (CashFlowFrame, CashFlowFrame)
splitCashFlowFrameByDate (CashFlowFrame BeginStatus
status [TsRow]
txns) Date
d SplitType
st
  = let 
      ([TsRow]
ls,[TsRow]
rs) = [TsRow] -> Date -> SplitType -> ([TsRow], [TsRow])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [TsRow]
txns Date
d SplitType
st
      newStatus :: (Principal, Date, Maybe a)
newStatus = case [TsRow]
rs of 
                    [] -> (Principal
0, Date
d, Maybe a
forall a. Maybe a
Nothing)
                    (TsRow
r:[TsRow]
_) -> ([TsRow] -> Principal
buildBegBal [TsRow]
rs, Date
d, Maybe a
forall a. Maybe a
Nothing)
    in 
      (BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
status [TsRow]
ls,BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
forall {a}. (Principal, Date, Maybe a)
newStatus [TsRow]
rs)


splitPoolCashflowByDate :: PoolCashflow -> Date -> SplitType -> (PoolCashflow,PoolCashflow)
splitPoolCashflowByDate :: PoolCashflow -> Date -> SplitType -> (PoolCashflow, PoolCashflow)
splitPoolCashflowByDate (CashFlowFrame
poolCF, Maybe [CashFlowFrame]
mAssetCfs) Date
d SplitType
st
  = let 
      (CashFlowFrame
lPoolCF,CashFlowFrame
rPoolCF) = CashFlowFrame
-> Date -> SplitType -> (CashFlowFrame, CashFlowFrame)
splitCashFlowFrameByDate CashFlowFrame
poolCF Date
d SplitType
st
      mAssetSplited :: Maybe [(CashFlowFrame, CashFlowFrame)]
mAssetSplited = (\[CashFlowFrame]
xs -> [ CashFlowFrame
-> Date -> SplitType -> (CashFlowFrame, CashFlowFrame)
splitCashFlowFrameByDate CashFlowFrame
x Date
d SplitType
st | CashFlowFrame
x <- [CashFlowFrame]
xs ]) ([CashFlowFrame] -> [(CashFlowFrame, CashFlowFrame)])
-> Maybe [CashFlowFrame] -> Maybe [(CashFlowFrame, CashFlowFrame)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CashFlowFrame]
mAssetCfs
      assetCfs :: Maybe [(CashFlowFrame, CashFlowFrame)]
assetCfs = (\[(CashFlowFrame, CashFlowFrame)]
xs -> [ (CashFlowFrame
lCf, CashFlowFrame
rCf) | (CashFlowFrame
lCf,CashFlowFrame
rCf) <- [(CashFlowFrame, CashFlowFrame)]
xs ]) ([(CashFlowFrame, CashFlowFrame)]
 -> [(CashFlowFrame, CashFlowFrame)])
-> Maybe [(CashFlowFrame, CashFlowFrame)]
-> Maybe [(CashFlowFrame, CashFlowFrame)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(CashFlowFrame, CashFlowFrame)]
mAssetSplited 
      lAssetCfs :: Maybe [CashFlowFrame]
lAssetCfs = ((CashFlowFrame, CashFlowFrame) -> CashFlowFrame
forall a b. (a, b) -> a
fst ((CashFlowFrame, CashFlowFrame) -> CashFlowFrame)
-> [(CashFlowFrame, CashFlowFrame)] -> [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(CashFlowFrame, CashFlowFrame)] -> [CashFlowFrame])
-> Maybe [(CashFlowFrame, CashFlowFrame)] -> Maybe [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(CashFlowFrame, CashFlowFrame)]
assetCfs
      rAssetCfs :: Maybe [CashFlowFrame]
rAssetCfs = ((CashFlowFrame, CashFlowFrame) -> CashFlowFrame
forall a b. (a, b) -> b
snd ((CashFlowFrame, CashFlowFrame) -> CashFlowFrame)
-> [(CashFlowFrame, CashFlowFrame)] -> [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(CashFlowFrame, CashFlowFrame)] -> [CashFlowFrame])
-> Maybe [(CashFlowFrame, CashFlowFrame)] -> Maybe [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(CashFlowFrame, CashFlowFrame)]
assetCfs
    in 
      ((CashFlowFrame
lPoolCF, Maybe [CashFlowFrame]
lAssetCfs) , (CashFlowFrame
rPoolCF, Maybe [CashFlowFrame]
rAssetCfs))


getTxnLatestAsOf :: CashFlowFrame -> Date -> Maybe TsRow
getTxnLatestAsOf :: CashFlowFrame -> Date -> Maybe TsRow
getTxnLatestAsOf (CashFlowFrame BeginStatus
_ [TsRow]
txn) Date
d = (TsRow -> Bool) -> [TsRow] -> Maybe TsRow
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\TsRow
x -> TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
d) ([TsRow] -> Maybe TsRow) -> [TsRow] -> Maybe TsRow
forall a b. (a -> b) -> a -> b
$ [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
txn

addTs :: TsRow -> TsRow -> TsRow     
-- ^ left cashflow is ealier ,right one is later,combine both and yield cashflow with earlier date
addTs :: TsRow -> TsRow -> TsRow
addTs (CashFlow Date
d1 Principal
a1 ) (CashFlow Date
_ Principal
a2 ) = Date -> Principal -> TsRow
CashFlow Date
d1 (Principal
a1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
a2)
addTs (BondFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 ) tr :: TsRow
tr@(BondFlow Date
_ Principal
b2 Principal
p2 Principal
i2 ) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
tr) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2)
addTs (MortgageFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(MortgageFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2)
  = let 
      bn :: Maybe Int
bn = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbn1 Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbn2
      p :: Maybe Principal
p =  Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) (Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe (Principal -> Principal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
pn1 Maybe (Principal -> Principal)
-> Maybe Principal -> Maybe Principal
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Principal
pn2
      st :: Maybe CumulativeStat
st = Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2
    in 
      Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
tr) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) Maybe Int
bn Maybe Principal
p Maybe CumulativeStat
st
addTs (MortgageDelinqFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
delinq1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(MortgageDelinqFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
delinq2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2)
  = let 
      bn :: Maybe Int
bn = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbn1 Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbn2
      p :: Maybe Principal
p =  Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) (Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe (Principal -> Principal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
pn1 Maybe (Principal -> Principal)
-> Maybe Principal -> Maybe Principal
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Principal
pn2
      delinq :: Principal
delinq = Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) Principal
delinq1 Principal
delinq2
      st :: Maybe CumulativeStat
st = Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2
    in 
      Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
tr) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) Principal
delinq (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) Maybe Int
bn Maybe Principal
p Maybe CumulativeStat
st

addTs (LoanFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(LoanFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe CumulativeStat
st2)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
tr) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)

addTs (LeaseFlow Date
d1 Principal
b1 Principal
r1 Principal
def1) tr :: TsRow
tr@(LeaseFlow Date
d2 Principal
b2 Principal
r2 Principal
def2) 
  = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
tr) (Principal
r1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
r2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2)

addTs (ReceivableFlow Date
d1 Principal
b1 Principal
af1 Principal
p1 Principal
fp1 Principal
def1 Principal
rec1 Principal
los1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(ReceivableFlow Date
_ Principal
b2 Principal
af2 Principal
p2 Principal
fp2 Principal
def2 Principal
rec2 Principal
los2 Maybe CumulativeStat
st2)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
tr) (Principal
af1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
af2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
fp1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
fp2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
los2) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)

combineTs :: TsRow -> TsRow -> TsRow     

-- ^ combine two cashflow records from two entities, return cashflow with earlier date
combineTs :: TsRow -> TsRow -> TsRow
combineTs (CashFlow Date
d1 Principal
a1 ) (CashFlow Date
_ Principal
a2 ) = Date -> Principal -> TsRow
CashFlow Date
d1 (Principal
a1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
a2)

combineTs (BondFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 ) tr :: TsRow
tr@(BondFlow Date
_ Principal
b2 Principal
p2 Principal
i2 ) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2)

combineTs (MortgageDelinqFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
delinq1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(MortgageDelinqFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
delinq2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2)
  = let 
      bn :: Maybe Int
bn = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbn1 Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbn2
      p :: Maybe Principal
p =  Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) (Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe (Principal -> Principal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
pn1 Maybe (Principal -> Principal)
-> Maybe Principal -> Maybe Principal
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Principal
pn2
      delinq :: Principal
delinq = Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) Principal
delinq1 Principal
delinq2
      st :: Maybe CumulativeStat
st = Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2
    in 
      Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) Principal
delinq (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) Maybe Int
bn Maybe Principal
p Maybe CumulativeStat
st

combineTs (MortgageFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(MortgageFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2)
  = let 
      bn :: Maybe Int
bn = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbn1 Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbn2
      p :: Maybe Principal
p =  Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) (Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe (Principal -> Principal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
pn1 Maybe (Principal -> Principal)
-> Maybe Principal -> Maybe Principal
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Principal
pn2
      st :: Maybe CumulativeStat
st = Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2
    in 
      Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) Maybe Int
bn Maybe Principal
p Maybe CumulativeStat
st

combineTs (LoanFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(LoanFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe CumulativeStat
st2)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)

combineTs (LeaseFlow Date
d1 Principal
b1 Principal
r1 Principal
def1) tr :: TsRow
tr@(LeaseFlow Date
d2 Principal
b2 Principal
r2 Principal
def2) 
  = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
r1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
r2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2)

combineTs (FixedFlow Date
d1 Principal
b1 Principal
de1 Principal
cde1 Principal
p1 Principal
c1 ) (FixedFlow Date
d2 Principal
b2 Principal
de2 Principal
cde2 Principal
p2 Principal
c2)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
d1 (Principal
b1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
b2) (Principal
de1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
de2) (Principal
cde1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
cde2) (Principal
p1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
p2) (Principal
c1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
c2)

combineTs (ReceivableFlow Date
d1 Principal
b1 Principal
af1 Principal
p1 Principal
fp1 Principal
def1 Principal
rec1 Principal
los1 Maybe CumulativeStat
st1) tr :: TsRow
tr@(ReceivableFlow Date
_ Principal
b2 Principal
af2 Principal
p2 Principal
fp2 Principal
def2 Principal
rec2 Principal
los2 Maybe CumulativeStat
st2)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
d1 (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b2) (Principal
af1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
af2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
fp1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
fp2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
los2) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)

-- ^ combine two cashflows from two entities,(auto patch a beg balance)
-- ^ left cashflow is ealier ,right one is later,combine both and yield cashflow with earlier date
combineTss :: [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss :: [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss [] [] [TsRow]
r = [TsRow]
r
combineTss [] [TsRow]
r [] = [TsRow]
r
combineTss [] (TsRow
r1:[TsRow]
r1s) (TsRow
r2:[TsRow]
r2s)
  | TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r1 Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r2 = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss [] (TsRow
r2TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
r2s) (TsRow
r1TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
r1s)
  | TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r1 Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r2 = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss [TsRow -> TsRow -> TsRow
combineTs TsRow
r1 TsRow
r2] [TsRow]
r1s [TsRow]
r2s -- `debug` ("combineTss after same"++show r1s++" "++show r2s)
  | Bool
otherwise = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss [ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (TsRow -> Principal
mflowBegBalance TsRow
r2Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+(Getting Principal TsRow Principal -> TsRow -> Principal
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Principal TsRow Principal
Lens' TsRow Principal
tsRowBalance TsRow
r1)) TsRow
r1]
                           [TsRow]
r1s
                           (TsRow
r2TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
r2s)
                           
combineTss [TsRow]
consols [] [] = [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
consols
combineTss (TsRow
consol:[TsRow]
consols) (TsRow
r:[TsRow]
rs) [] = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss (TsRow -> TsRow -> TsRow
appendTs TsRow
consol TsRow
rTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
consolTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
consols) [TsRow]
rs []
combineTss (TsRow
consol:[TsRow]
consols) [] (TsRow
tr:[TsRow]
trs) = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss (TsRow -> TsRow -> TsRow
appendTs TsRow
consol TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
consolTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
consols) [] [TsRow]
trs
combineTss (TsRow
consol:[TsRow]
consols) (TsRow
r:[TsRow]
rs) (TsRow
tr:[TsRow]
trs)
  | TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
tr = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss (TsRow -> TsRow -> TsRow
appendTs TsRow
consol (TsRow -> TsRow -> TsRow
combineTs TsRow
r TsRow
tr)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
consolTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
consols) [TsRow]
rs [TsRow]
trs
  | TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
tr = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss (TsRow -> TsRow -> TsRow
appendTs TsRow
consol TsRow
rTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
consolTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
consols) [TsRow]
rs (TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs)
  | TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
tr = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss (TsRow -> TsRow -> TsRow
appendTs TsRow
consol TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
consolTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
consols) (TsRow
rTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs) [TsRow]
trs 
combineTss [TsRow]
a [TsRow]
b [TsRow]
c = String -> [TsRow]
forall a. HasCallStack => String -> a
error (String -> [TsRow]) -> String -> [TsRow]
forall a b. (a -> b) -> a -> b
$ String
"combineTss not supported "String -> ShowS
forall a. [a] -> [a] -> [a]
++[TsRow] -> String
forall a. Show a => a -> String
show [TsRow]
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++[TsRow] -> String
forall a. Show a => a -> String
show [TsRow]
bString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++[TsRow] -> String
forall a. Show a => a -> String
show [TsRow]
c



appendTs :: TsRow -> TsRow -> TsRow 
-- ^ combine two cashflow records from two entities ,(early row on left, later row on right)
appendTs :: TsRow -> TsRow -> TsRow
appendTs bn1 :: TsRow
bn1@(BondFlow Date
d1 Principal
b1 Principal
_ Principal
_ ) bn2 :: TsRow
bn2@(BondFlow Date
d2 Principal
b2 Principal
p2 Principal
i2 ) 
  = ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
bn2) TsRow
bn2 -- `debug` ("b1 >> "++show b1++">>"++show (mflowAmortAmount bn2))
appendTs (MortgageDelinqFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
_ Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
_ Maybe CumulativeStat
mstat1) bn2 :: TsRow
bn2@(MortgageDelinqFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
_ Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
_ Maybe CumulativeStat
mstat2)
  = ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
bn2) TsRow
bn2
appendTs bn1 :: TsRow
bn1@(MortgageFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
_ Maybe CumulativeStat
mstat1) bn2 :: TsRow
bn2@(MortgageFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
_ Maybe CumulativeStat
mstat2)
  =  ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
bn2) TsRow
bn2 -- `debug` ("Summing stats"++ show bn1 ++ show mstat1++">>"++ show bn2 ++ show mstat2)
appendTs (LoanFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe CumulativeStat
mstat1) bn2 :: TsRow
bn2@(LoanFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe CumulativeStat
mstat2)
  =  ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
bn2) TsRow
bn2
appendTs (LeaseFlow Date
d1 Principal
b1 Principal
r1 Principal
def1) bn2 :: TsRow
bn2@(LeaseFlow Date
d2 Principal
b2 Principal
r2 Principal
def2) 
  = ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
bn2) TsRow
bn2
appendTs (FixedFlow Date
d1 Principal
b1 Principal
de1 Principal
cde1 Principal
p1 Principal
c1 ) bn2 :: TsRow
bn2@(FixedFlow Date
d2 Principal
b2 Principal
de2 Principal
cde2 Principal
p2 Principal
c2)
  = ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
bn2) TsRow
bn2
appendTs (ReceivableFlow Date
d1 Principal
b1 Principal
af1 Principal
p1 Principal
fp1 Principal
def1 Principal
rec1 Principal
los1 Maybe CumulativeStat
mstat1) bn2 :: TsRow
bn2@(ReceivableFlow Date
_ Principal
b2 Principal
af2 Principal
p2 Principal
fp2 Principal
def2 Principal
rec2 Principal
los2 Maybe CumulativeStat
mstat2)
  =  ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance (Principal
b1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- TsRow -> Principal
mflowAmortAmount TsRow
bn2) TsRow
bn2
appendTs TsRow
_1 TsRow
_2 = String -> TsRow
forall a. HasCallStack => String -> a
error (String -> TsRow) -> String -> TsRow
forall a b. (a -> b) -> a -> b
$ String
"appendTs failed with "String -> ShowS
forall a. [a] -> [a] -> [a]
++ TsRow -> String
forall a. Show a => a -> String
show TsRow
_1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TsRow -> String
forall a. Show a => a -> String
show TsRow
_2

-- ^ add up TsRow from same entity
addTsCF :: TsRow -> TsRow -> TsRow
addTsCF :: TsRow -> TsRow -> TsRow
addTsCF (CashFlow Date
d1 Principal
a1 ) (CashFlow Date
_ Principal
a2 ) = Date -> Principal -> TsRow
CashFlow Date
d1 (Principal
a1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
a2)
addTsCF (BondFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 ) (BondFlow Date
_ Principal
b2 Principal
p2 Principal
i2 ) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
d1 (Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
min Principal
b1 Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2)
addTsCF m1 :: TsRow
m1@(MortgageFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1) m2 :: TsRow
m2@(MortgageFlow Date
d2 Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2)
  = let 
      bn :: Maybe Int
bn = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbn1 Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbn2
      p :: Maybe Principal
p =  Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) (Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe (Principal -> Principal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
pn1 Maybe (Principal -> Principal)
-> Maybe Principal -> Maybe Principal
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Principal
pn2
      st :: Maybe CumulativeStat
st = Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
maxStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2
    in 
      Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d1 (Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
min Principal
b1 Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) Maybe Int
bn Maybe Principal
p Maybe CumulativeStat
st 
addTsCF (MortgageDelinqFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
delinq1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe Int
mbn1 Maybe Principal
pn1 Maybe CumulativeStat
st1) (MortgageDelinqFlow Date
d2 Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
delinq2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe Int
mbn2 Maybe Principal
pn2 Maybe CumulativeStat
st2)
  = let 
      bn :: Maybe Int
bn = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbn1 Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbn2
      p :: Maybe Principal
p =  Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) (Principal -> Principal -> Principal)
-> Maybe Principal -> Maybe (Principal -> Principal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
pn1 Maybe (Principal -> Principal)
-> Maybe Principal -> Maybe Principal
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Principal
pn2
      delinq :: Principal
delinq = Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
(+) Principal
delinq1 Principal
delinq2
      st :: Maybe CumulativeStat
st = Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
maxStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2
    in 
      Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d1 (Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
min Principal
b1 Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) Principal
delinq (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) Maybe Int
bn Maybe Principal
p Maybe CumulativeStat
st
addTsCF (LoanFlow Date
d1 Principal
b1 Principal
p1 Principal
i1 Principal
prep1 Principal
def1 Principal
rec1 Principal
los1 IRate
rat1 Maybe CumulativeStat
st1) (LoanFlow Date
_ Principal
b2 Principal
p2 Principal
i2 Principal
prep2 Principal
def2 Principal
rec2 Principal
los2 IRate
rat2 Maybe CumulativeStat
st2)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
d1 (Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
min Principal
b1 Principal
b2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
i1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
i2) (Principal
prep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
prep2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
los2) (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational ([Rational] -> [Rational] -> Rational
weightedBy (Principal -> Rational
forall a. Real a => a -> Rational
toRational (Principal -> Rational) -> [Principal] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Principal
b1,Principal
b2]) (IRate -> Rational
forall a. Real a => a -> Rational
toRational (IRate -> Rational) -> [IRate] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate
rat1,IRate
rat2]))) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
maxStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)
addTsCF (LeaseFlow Date
d1 Principal
b1 Principal
r1 Principal
def1) (LeaseFlow Date
d2 Principal
b2 Principal
r2 Principal
def2) = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
d1 (Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
min Principal
b1 Principal
b2) (Principal
r1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
r2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2)
addTsCF (FixedFlow Date
d1 Principal
b1 Principal
dep1 Principal
cd1 Principal
u1 Principal
c1) (FixedFlow Date
d2 Principal
b2 Principal
dep2 Principal
cd2 Principal
u2 Principal
c2) 
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
d1 (Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
min Principal
b1 Principal
b2) (Principal
dep1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
dep2) (Principal
cd1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
cd2) Principal
u2 (Principal
c1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
c2)
addTsCF (ReceivableFlow Date
d1 Principal
b1 Principal
af1 Principal
p1 Principal
fp1 Principal
def1 Principal
rec1 Principal
los1 Maybe CumulativeStat
st1) (ReceivableFlow Date
d2 Principal
b2 Principal
af2 Principal
p2 Principal
fp2 Principal
def2 Principal
rec2 Principal
los2 Maybe CumulativeStat
st2)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
d1 (Principal -> Principal -> Principal
forall a. Ord a => a -> a -> a
min Principal
b1 Principal
b2) (Principal
af1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
af2) (Principal
p1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p2) (Principal
fp1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
fp2) (Principal
def1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def2) (Principal
rec1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
rec2) (Principal
los1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
los2) (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
maxStats Maybe CumulativeStat
st1 Maybe CumulativeStat
st2)


buildBegBal :: [TsRow] -> Balance
buildBegBal :: [TsRow] -> Principal
buildBegBal [] = Principal
0
buildBegBal (TsRow
x:[TsRow]
xs) = TsRow -> Principal
mflowBegBalance TsRow
x


sumTs :: [TsRow] -> Date -> TsRow
sumTs :: [TsRow] -> Date -> TsRow
sumTs [TsRow]
trs Date
d = 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
tsDate Date
d ((TsRow -> TsRow -> TsRow) -> [TsRow] -> TsRow
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 TsRow -> TsRow -> TsRow
addTs [TsRow]
trs)

-- ^ group cashflow from same entity by a single date
sumTsCF :: [TsRow] -> Date -> TsRow
-- sumTsCF [] = tsSetDate (foldl1 addTsCF trs) -- `debug` ("Summing"++show trs++">>"++ show (tsSetDate (foldr1 addTsCF trs) d))
sumTsCF :: [TsRow] -> Date -> TsRow
sumTsCF [] Date
_ = String -> TsRow
forall a. HasCallStack => String -> a
error String
"sumTsCF failed with empty list"
sumTsCF [TsRow]
trs Date
d = 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
tsDate Date
d ((TsRow -> TsRow -> TsRow) -> [TsRow] -> TsRow
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 TsRow -> TsRow -> TsRow
addTsCF [TsRow]
trs) --  `debug` ("Summing"++show trs++">>"++ show (tsSetDate (foldr1 addTsCF trs) d))

tsTotalCash :: TsRow -> Balance
tsTotalCash :: TsRow -> Principal
tsTotalCash (CashFlow Date
_ Principal
x) = Principal
x
tsTotalCash (BondFlow Date
_ Principal
_ Principal
a Principal
b) = Principal
a Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b
tsTotalCash (MortgageDelinqFlow Date
x Principal
_ Principal
a Principal
b Principal
c Principal
_ Principal
_ Principal
e Principal
_ IRate
_ Maybe Int
_ Maybe Principal
mPn Maybe CumulativeStat
_ ) = Principal
a Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
c Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
e Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal -> Maybe Principal -> Principal
forall a. a -> Maybe a -> a
fromMaybe Principal
0 Maybe Principal
mPn
tsTotalCash (MortgageFlow Date
x Principal
_ Principal
a Principal
b Principal
c Principal
_ Principal
e Principal
_ IRate
_ Maybe Int
_ Maybe Principal
mPn Maybe CumulativeStat
_) = Principal
a Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
c Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
e Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal -> Maybe Principal -> Principal
forall a. a -> Maybe a -> a
fromMaybe Principal
0 Maybe Principal
mPn
tsTotalCash (LoanFlow Date
_ Principal
_ Principal
a Principal
b Principal
c Principal
_ Principal
e Principal
_ IRate
_ Maybe CumulativeStat
_) =  Principal
a Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
c Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
e
tsTotalCash (LeaseFlow Date
_ Principal
_ Principal
a Principal
_) =  Principal
a
tsTotalCash (FixedFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x) = Principal
x
tsTotalCash (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
a Principal
b Principal
_ Principal
c Principal
_ Maybe CumulativeStat
_ ) = Principal
a Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
c

tsDefaultBal :: TsRow -> Either String Balance
tsDefaultBal :: TsRow -> Either String Principal
tsDefaultBal CashFlow {} = String -> Either String Principal
forall a b. a -> Either a b
Left String
"no default amount for bond flow"
tsDefaultBal BondFlow {} = String -> Either String Principal
forall a b. a -> Either a b
Left String
"no default amount for bond flow"
tsDefaultBal (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal -> Either String Principal
forall a b. b -> Either a b
Right Principal
x
tsDefaultBal (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal -> Either String Principal
forall a b. b -> Either a b
Right Principal
x
tsDefaultBal (LoanFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal -> Either String Principal
forall a b. b -> Either a b
Right Principal
x
tsDefaultBal (LeaseFlow Date
_ Principal
_ Principal
_ Principal
x) = Principal -> Either String Principal
forall a b. b -> Either a b
Right Principal
x
tsDefaultBal (FixedFlow Date
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_) =  Principal -> Either String Principal
forall a b. b -> Either a b
Right Principal
x
tsDefaultBal (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Maybe CumulativeStat
_ ) = Principal -> Either String Principal
forall a b. b -> Either a b
Right Principal
x

tsCumulative :: Lens' TsRow (Maybe CumulativeStat)
tsCumulative :: Lens' TsRow (Maybe CumulativeStat)
tsCumulative = (TsRow -> Maybe CumulativeStat)
-> (TsRow -> Maybe CumulativeStat -> TsRow)
-> Lens' TsRow (Maybe CumulativeStat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TsRow -> Maybe CumulativeStat
getter TsRow -> Maybe CumulativeStat -> TsRow
setter
  where
    getter :: TsRow -> Maybe CumulativeStat
getter (MortgageDelinqFlow  Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter (MortgageFlow  Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter (LoanFlow  Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter TsRow
_ = Maybe CumulativeStat
forall a. Maybe a
Nothing

    setter :: TsRow -> Maybe CumulativeStat -> TsRow
setter (MortgageDelinqFlow  Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
_) Maybe CumulativeStat
mStat = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
mStat
    setter (MortgageFlow  Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
_) Maybe CumulativeStat
mStat = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
mStat
    setter (LoanFlow  Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe CumulativeStat
_) Maybe CumulativeStat
mStat = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe CumulativeStat
mStat
    setter (ReceivableFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Maybe CumulativeStat
_) Maybe CumulativeStat
mStat = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Maybe CumulativeStat
mStat
    setter TsRow
x Maybe CumulativeStat
_ = TsRow
x

tsCumDefaultBal :: TsRow -> Maybe Balance
tsCumDefaultBal :: TsRow -> Maybe Principal
tsCumDefaultBal TsRow
tr = Getting (First Principal) TsRow Principal
-> TsRow -> Maybe Principal
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> TsRow -> Const (First Principal) TsRow
Lens' TsRow (Maybe CumulativeStat)
tsCumulative ((Maybe CumulativeStat
  -> Const (First Principal) (Maybe CumulativeStat))
 -> TsRow -> Const (First Principal) TsRow)
-> ((Principal -> Const (First Principal) Principal)
    -> Maybe CumulativeStat
    -> Const (First Principal) (Maybe CumulativeStat))
-> Getting (First Principal) TsRow Principal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CumulativeStat -> Const (First Principal) CumulativeStat)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CumulativeStat -> Const (First Principal) CumulativeStat)
 -> Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> ((Principal -> Const (First Principal) Principal)
    -> CumulativeStat -> Const (First Principal) CumulativeStat)
-> (Principal -> Const (First Principal) Principal)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Principal -> Const (First Principal) Principal)
-> CumulativeStat -> Const (First Principal) CumulativeStat
forall s t a b. Field4 s t a b => Lens s t a b
Lens CumulativeStat CumulativeStat Principal Principal
_4) TsRow
tr

tsCumDelinqBal :: TsRow -> Maybe Balance
tsCumDelinqBal :: TsRow -> Maybe Principal
tsCumDelinqBal TsRow
tr = Getting (First Principal) TsRow Principal
-> TsRow -> Maybe Principal
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> TsRow -> Const (First Principal) TsRow
Lens' TsRow (Maybe CumulativeStat)
tsCumulative ((Maybe CumulativeStat
  -> Const (First Principal) (Maybe CumulativeStat))
 -> TsRow -> Const (First Principal) TsRow)
-> ((Principal -> Const (First Principal) Principal)
    -> Maybe CumulativeStat
    -> Const (First Principal) (Maybe CumulativeStat))
-> Getting (First Principal) TsRow Principal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CumulativeStat -> Const (First Principal) CumulativeStat)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CumulativeStat -> Const (First Principal) CumulativeStat)
 -> Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> ((Principal -> Const (First Principal) Principal)
    -> CumulativeStat -> Const (First Principal) CumulativeStat)
-> (Principal -> Const (First Principal) Principal)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Principal -> Const (First Principal) Principal)
-> CumulativeStat -> Const (First Principal) CumulativeStat
forall s t a b. Field3 s t a b => Lens s t a b
Lens CumulativeStat CumulativeStat Principal Principal
_3) TsRow
tr

tsCumLossBal :: TsRow -> Maybe Balance
tsCumLossBal :: TsRow -> Maybe Principal
tsCumLossBal TsRow
tr = Getting (First Principal) TsRow Principal
-> TsRow -> Maybe Principal
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> TsRow -> Const (First Principal) TsRow
Lens' TsRow (Maybe CumulativeStat)
tsCumulative ((Maybe CumulativeStat
  -> Const (First Principal) (Maybe CumulativeStat))
 -> TsRow -> Const (First Principal) TsRow)
-> ((Principal -> Const (First Principal) Principal)
    -> Maybe CumulativeStat
    -> Const (First Principal) (Maybe CumulativeStat))
-> Getting (First Principal) TsRow Principal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CumulativeStat -> Const (First Principal) CumulativeStat)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CumulativeStat -> Const (First Principal) CumulativeStat)
 -> Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> ((Principal -> Const (First Principal) Principal)
    -> CumulativeStat -> Const (First Principal) CumulativeStat)
-> (Principal -> Const (First Principal) Principal)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Principal -> Const (First Principal) Principal)
-> CumulativeStat -> Const (First Principal) CumulativeStat
forall s t a b. Field6 s t a b => Lens s t a b
Lens CumulativeStat CumulativeStat Principal Principal
_6) TsRow
tr

tsCumRecoveriesBal :: TsRow -> Maybe Balance
tsCumRecoveriesBal :: TsRow -> Maybe Principal
tsCumRecoveriesBal TsRow
tr = Getting (First Principal) TsRow Principal
-> TsRow -> Maybe Principal
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> TsRow -> Const (First Principal) TsRow
Lens' TsRow (Maybe CumulativeStat)
tsCumulative ((Maybe CumulativeStat
  -> Const (First Principal) (Maybe CumulativeStat))
 -> TsRow -> Const (First Principal) TsRow)
-> ((Principal -> Const (First Principal) Principal)
    -> Maybe CumulativeStat
    -> Const (First Principal) (Maybe CumulativeStat))
-> Getting (First Principal) TsRow Principal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CumulativeStat -> Const (First Principal) CumulativeStat)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CumulativeStat -> Const (First Principal) CumulativeStat)
 -> Maybe CumulativeStat
 -> Const (First Principal) (Maybe CumulativeStat))
-> ((Principal -> Const (First Principal) Principal)
    -> CumulativeStat -> Const (First Principal) CumulativeStat)
-> (Principal -> Const (First Principal) Principal)
-> Maybe CumulativeStat
-> Const (First Principal) (Maybe CumulativeStat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Principal -> Const (First Principal) Principal)
-> CumulativeStat -> Const (First Principal) CumulativeStat
forall s t a b. Field5 s t a b => Lens s t a b
Lens CumulativeStat CumulativeStat Principal Principal
_5) TsRow
tr

tsDate :: Lens' TsRow Date 
tsDate :: Lens' TsRow Date
tsDate = (TsRow -> Date) -> (TsRow -> Date -> TsRow) -> Lens' TsRow Date
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TsRow -> Date
getter TsRow -> Date -> TsRow
setter 
  where 
    getter :: TsRow -> Date
getter (CashFlow Date
x Principal
_) = Date
x
    getter (BondFlow Date
x Principal
_ Principal
_ Principal
_) = Date
x
    getter (MortgageDelinqFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Date
x 
    getter (MortgageFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Date
x
    getter (LoanFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Date
x
    getter (LeaseFlow Date
x Principal
_ Principal
_ Principal
_ ) = Date
x
    getter (FixedFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_) = Date
x
    getter (ReceivableFlow Date
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Maybe CumulativeStat
_) = Date
x
    setter :: TsRow -> Date -> TsRow
setter (CashFlow Date
_ Principal
a) Date
x = Date -> Principal -> TsRow
CashFlow Date
x Principal
a
    setter (BondFlow Date
_ Principal
a Principal
b Principal
c) Date
x = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
x Principal
a Principal
b Principal
c
    setter (MortgageDelinqFlow Date
_ Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) Date
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
x Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l
    setter (MortgageFlow Date
_ Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k) Date
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
x Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k
    setter (LoanFlow Date
_ Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i) Date
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
x Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i
    setter (LeaseFlow Date
_ Principal
a Principal
b Principal
c) Date
x = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
x Principal
a Principal
b Principal
c
    setter (FixedFlow Date
_ Principal
a Principal
b Principal
c Principal
d Principal
e) Date
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
x Principal
a Principal
b Principal
c Principal
d Principal
e
    setter (ReceivableFlow Date
_ Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h) Date
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
x Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h

tsSetLoss :: Balance -> TsRow -> TsRow
tsSetLoss :: Principal -> TsRow -> TsRow
tsSetLoss Principal
x (MortgageDelinqFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
x IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l
tsSetLoss Principal
x (MortgageFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
x IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k 
tsSetLoss Principal
x (LoanFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
x IRate
h Maybe CumulativeStat
i
tsSetLoss Principal
x (ReceivableFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
x Maybe CumulativeStat
h
tsSetLoss Principal
x TsRow
_ = String -> TsRow
forall a. HasCallStack => String -> a
error (String -> TsRow) -> String -> TsRow
forall a b. (a -> b) -> a -> b
$ String
"Failed to set Loss for "String -> ShowS
forall a. [a] -> [a] -> [a]
++Principal -> String
forall a. Show a => a -> String
show Principal
x

tsSetRecovery :: Balance -> TsRow -> TsRow
tsSetRecovery :: Principal -> TsRow -> TsRow
tsSetRecovery Principal
x (MortgageDelinqFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
x Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l
tsSetRecovery Principal
x (MortgageFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
x Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k 
tsSetRecovery Principal
x (LoanFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
x Principal
g IRate
h Maybe CumulativeStat
i
tsSetRecovery Principal
x (ReceivableFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
x Principal
g Maybe CumulativeStat
h
tsSetRecovery Principal
x TsRow
_ = String -> TsRow
forall a. HasCallStack => String -> a
error (String -> TsRow) -> String -> TsRow
forall a b. (a -> b) -> a -> b
$ String
"Failed to set Recovery for "String -> ShowS
forall a. [a] -> [a] -> [a]
++Principal -> String
forall a. Show a => a -> String
show Principal
x

tsOffsetDate :: Integer -> TsRow -> TsRow
tsOffsetDate :: Integer -> TsRow -> TsRow
tsOffsetDate Integer
x (CashFlow Date
_d Principal
a) = Date -> Principal -> TsRow
CashFlow (Integer -> Date -> Date
T.addDays Integer
x Date
_d) Principal
a
tsOffsetDate Integer
x (BondFlow Date
_d Principal
a Principal
b Principal
c) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow (Integer -> Date -> Date
T.addDays Integer
x Date
_d) Principal
a Principal
b Principal
c
tsOffsetDate Integer
x (MortgageDelinqFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow (Integer -> Date -> Date
T.addDays Integer
x Date
_d) Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l
tsOffsetDate Integer
x (MortgageFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow (Integer -> Date -> Date
T.addDays Integer
x Date
_d) Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k
tsOffsetDate Integer
x (LoanFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow (Integer -> Date -> Date
T.addDays Integer
x Date
_d) Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i
tsOffsetDate Integer
x (LeaseFlow Date
_d Principal
a Principal
b Principal
c) = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow (Integer -> Date -> Date
T.addDays Integer
x Date
_d) Principal
a Principal
b Principal
c
tsOffsetDate Integer
x (ReceivableFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow (Integer -> Date -> Date
T.addDays Integer
x Date
_d) Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h

tsReduceInt :: Balance -> TsRow -> TsRow
tsReduceInt :: Principal -> TsRow -> TsRow
tsReduceInt Principal
x (BondFlow Date
_d Principal
a Principal
b Principal
c) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
_d Principal
a Principal
b (Principal
cPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
-Principal
x)
tsReduceInt Principal
x (MortgageDelinqFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
_d Principal
a Principal
b (Principal
cPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
-Principal
x) Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l
tsReduceInt Principal
x (MortgageFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
_d Principal
a Principal
b (Principal
cPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
-Principal
x) Principal
d Principal
e Principal
f Principal
g IRate
h Maybe Int
i Maybe Principal
j Maybe CumulativeStat
k 
tsReduceInt Principal
x (LoanFlow Date
_d Principal
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
_d Principal
a Principal
b (Principal
cPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
-Principal
x) Principal
d Principal
e Principal
f Principal
g IRate
h Maybe CumulativeStat
i
tsReduceInt Principal
_ TsRow
x = String -> TsRow
forall a. HasCallStack => String -> a
error (String -> TsRow) -> String -> TsRow
forall a b. (a -> b) -> a -> b
$ String
"Failed to reduce interest on asset "String -> ShowS
forall a. [a] -> [a] -> [a]
++ TsRow -> String
forall a. Show a => a -> String
show TsRow
x

-- ^ claw back interest from cashflow records
clawbackInt :: Balance -> [TsRow] -> [TsRow]
clawbackInt :: Principal -> [TsRow] -> [TsRow]
clawbackInt Principal
bal [TsRow]
txns
  = let
      intFlow :: [Principal]
intFlow = TsRow -> Principal
mflowInterest (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
txns
      intDowns :: [Principal]
intDowns = Principal -> [Principal] -> [Principal]
paySeqLiabilitiesAmt Principal
bal [Principal]
intFlow
    in 
      [ Principal -> TsRow -> TsRow
tsReduceInt Principal
intDown TsRow
txn | (TsRow
txn,Principal
intDown) <- [TsRow] -> [Principal] -> [(TsRow, Principal)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TsRow]
txns [Principal]
intDowns]

aggregateTsByDate :: [TsRow] -> [TsRow] -> [TsRow]
aggregateTsByDate :: [TsRow] -> [TsRow] -> [TsRow]
aggregateTsByDate [TsRow]
rs [] = [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
rs
aggregateTsByDate [] (TsRow
tr:[TsRow]
trs) = [TsRow] -> [TsRow] -> [TsRow]
aggregateTsByDate [TsRow
tr] [TsRow]
trs
aggregateTsByDate (TsRow
r:[TsRow]
rs) (TsRow
tr:[TsRow]
trs) 
  | TsRow -> TsRow -> Bool
forall ts. TimeSeries ts => ts -> ts -> Bool
sameDate TsRow
r TsRow
tr = [TsRow] -> [TsRow] -> [TsRow]
aggregateTsByDate (TsRow -> TsRow -> TsRow
combineTs TsRow
r TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs) [TsRow]
trs
  | Bool
otherwise = [TsRow] -> [TsRow] -> [TsRow]
aggregateTsByDate (TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
rTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs) [TsRow]
trs


firstDate :: CashFlowFrame -> Date 
firstDate :: CashFlowFrame -> Date
firstDate (CashFlowFrame BeginStatus
_ []) = String -> Date
forall a. HasCallStack => String -> a
error String
"empty cashflow frame to get first date"
firstDate (CashFlowFrame BeginStatus
_ [TsRow
r]) = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r
firstDate (CashFlowFrame BeginStatus
_ (TsRow
r:[TsRow]
rs)) = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate TsRow
r


-- ! combine two cashflow frames from two entities
-- ! cashflow earlier on the left ,later cashflow on the right
combine :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame 
combine :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
combine (CashFlowFrame BeginStatus
st1 []) (CashFlowFrame BeginStatus
st2 []) = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st1 []
combine (CashFlowFrame BeginStatus
_ []) CashFlowFrame
cf2 = CashFlowFrame
cf2
combine CashFlowFrame
cf1 (CashFlowFrame BeginStatus
_ []) = CashFlowFrame
cf1
combine cf1 :: CashFlowFrame
cf1@(CashFlowFrame st1 :: BeginStatus
st1@(Principal
begBal1,Date
begDate1,Maybe Principal
acc1) [TsRow]
txn1) cf2 :: CashFlowFrame
cf2@(CashFlowFrame st2 :: BeginStatus
st2@(Principal
begBal2,Date
begDate2,Maybe Principal
acc2) [TsRow]
txn2) 
  | Date
begDate1 Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
begDate2 = CashFlowFrame -> CashFlowFrame -> CashFlowFrame
combine CashFlowFrame
cf2 CashFlowFrame
cf1
  | Bool
otherwise =
    let 
      txns :: [TsRow]
txns = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss [] [TsRow]
txn1 [TsRow]
txn2
    in 
      BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame (Principal
begBal1,Date
begDate1,Maybe Principal
acc1) [TsRow]
txns 

buildCollectedCF :: [[TsRow]] -> [Date] -> [TsRow] -> [[TsRow]]
buildCollectedCF :: [[TsRow]] -> [Date] -> [TsRow] -> [[TsRow]]
buildCollectedCF [] [] [] = []
buildCollectedCF [[TsRow]]
trs [] [TsRow]
_trs = [[TsRow]]
trs
buildCollectedCF [[TsRow]]
trs [Date]
ds [] = [[TsRow]]
trs [[TsRow]] -> [[TsRow]] -> [[TsRow]]
forall a. [a] -> [a] -> [a]
++ [ [Date -> TsRow -> TsRow
viewTsRow Date
_d (([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last ([TsRow] -> TsRow) -> ([[TsRow]] -> [TsRow]) -> [[TsRow]] -> TsRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[TsRow]] -> [TsRow]
forall a. HasCallStack => [a] -> a
last) [[TsRow]]
trs)] | Date
_d <- [Date]
ds ]
buildCollectedCF [[TsRow]]
trs (Date
d:[Date]
ds) [TsRow]
_trs =
  case [TsRow]
newFlow of
    [] -> case [[TsRow]] -> ([TsRow] -> Bool) -> Maybe [TsRow]
forall a. [a] -> (a -> Bool) -> Maybe a
Util.lastOf [[TsRow]]
trs (Bool -> Bool
not (Bool -> Bool) -> ([TsRow] -> Bool) -> [TsRow] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TsRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) of
            Maybe [TsRow]
Nothing -> [[TsRow]] -> [Date] -> [TsRow] -> [[TsRow]]
buildCollectedCF ([[TsRow]]
trs[[TsRow]] -> [[TsRow]] -> [[TsRow]]
forall a. [a] -> [a] -> [a]
++[[]]) [Date]
ds [TsRow]
_trs  -- `debug` ("empty trs"++ show d)
            Just [TsRow]
lastTr ->  [[TsRow]] -> [Date] -> [TsRow] -> [[TsRow]]
buildCollectedCF ([[TsRow]]
trs[[TsRow]] -> [[TsRow]] -> [[TsRow]]
forall a. [a] -> [a] -> [a]
++[[Date -> TsRow -> TsRow
viewTsRow Date
d ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
lastTr)]]) [Date]
ds [TsRow]
_trs -- `debug` ("non empty last tr "++ show lastTr ++ "for date"++ show d++"insert with "++show (viewTsRow d (last lastTr)))
    [TsRow]
newFlow -> [[TsRow]] -> [Date] -> [TsRow] -> [[TsRow]]
buildCollectedCF ([[TsRow]]
trs[[TsRow]] -> [[TsRow]] -> [[TsRow]]
forall a. [a] -> [a] -> [a]
++[[TsRow]
newFlow]) [Date]
ds [TsRow]
remains
  where 
    ([TsRow]
newFlow, [TsRow]
remains) = Date -> CutoffType -> [TsRow] -> ([TsRow], [TsRow])
forall ts.
TimeSeries ts =>
Date -> CutoffType -> [ts] -> ([ts], [ts])
splitBy Date
d CutoffType
Inc [TsRow]
_trs

buildCollectedCF [[TsRow]]
a [Date]
b [TsRow]
c = String -> [[TsRow]]
forall a. HasCallStack => String -> a
error (String -> [[TsRow]]) -> String -> [[TsRow]]
forall a b. (a -> b) -> a -> b
$ String
"buildCollectedCF failed"String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[TsRow]] -> String
forall a. Show a => a -> String
show [[TsRow]]
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
">>"String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Date] -> String
forall a. Show a => a -> String
show [Date]
bString -> ShowS
forall a. [a] -> [a] -> [a]
++String
">>"String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TsRow] -> String
forall a. Show a => a -> String
show [TsRow]
c


aggTsByDates :: [TsRow] -> [Date] -> [TsRow]
aggTsByDates :: [TsRow] -> [Date] -> [TsRow]
aggTsByDates [] [Date]
ds = []
aggTsByDates [TsRow]
trs [Date]
ds = ([TsRow] -> Date -> TsRow) -> ([TsRow], Date) -> TsRow
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [TsRow] -> Date -> TsRow
sumTsCF (([TsRow], Date) -> TsRow) -> [([TsRow], Date)] -> [TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([TsRow], Date) -> Bool) -> [([TsRow], Date)] -> [([TsRow], Date)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([TsRow]
cfs,Date
_d) -> (Bool -> Bool
not (Bool -> Bool) -> ([TsRow] -> Bool) -> [TsRow] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TsRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [TsRow]
cfs) ([[TsRow]] -> [Date] -> [([TsRow], Date)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[TsRow]] -> [Date] -> [TsRow] -> [[TsRow]]
buildCollectedCF [] [Date]
ds [TsRow]
trs) [Date]
ds) -- `debug` (">>> to sumTsCF "++ show (zip (buildCollectedCF [] ds trs) ds ))

mflowPrincipal :: TsRow -> Balance
mflowPrincipal :: TsRow -> Principal
mflowPrincipal (BondFlow Date
_ Principal
_ Principal
p Principal
_) = Principal
p
mflowPrincipal (MortgageFlow Date
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowPrincipal (MortgageDelinqFlow Date
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowPrincipal (LoanFlow Date
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x
mflowPrincipal (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowPrincipal TsRow
_  = String -> Principal
forall a. HasCallStack => String -> a
error String
"not supported"

mflowInterest :: TsRow -> Balance
mflowInterest :: TsRow -> Principal
mflowInterest (BondFlow Date
_ Principal
_ Principal
_ Principal
i) = Principal
i
mflowInterest (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowInterest (MortgageFlow Date
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowInterest (LoanFlow Date
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x
mflowInterest TsRow
x  = String -> Principal
forall a. HasCallStack => String -> a
error (String -> Principal) -> String -> Principal
forall a b. (a -> b) -> a -> b
$ String
"not supported: getting interest from row" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TsRow -> String
forall a. Show a => a -> String
show TsRow
x

mflowPrepayment :: TsRow -> Balance
mflowPrepayment :: TsRow -> Principal
mflowPrepayment (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowPrepayment (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowPrepayment (LoanFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x
mflowPrepayment TsRow
_  = String -> Principal
forall a. HasCallStack => String -> a
error String
"not supported"

mflowDefault :: TsRow -> Balance
mflowDefault :: TsRow -> Principal
mflowDefault (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowDefault (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowDefault (LoanFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x
mflowDefault (FixedFlow Date
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_) = Principal
x
mflowDefault (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Maybe CumulativeStat
_ ) = Principal
x
mflowDefault TsRow
_  = Principal
0

mflowRecovery :: TsRow -> Balance
mflowRecovery :: TsRow -> Principal
mflowRecovery (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowRecovery (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowRecovery (LoanFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x
mflowRecovery FixedFlow {} = Principal
0
mflowRecovery (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Maybe CumulativeStat
_ ) = Principal
x
mflowRecovery (LeaseFlow Date
_ Principal
_ Principal
_ Principal
_) = Principal
0
mflowRecovery TsRow
_  = String -> Principal
forall a. HasCallStack => String -> a
error String
"not supported"

tsRowBalance :: Lens' TsRow Balance
tsRowBalance :: Lens' TsRow Principal
tsRowBalance = (TsRow -> Principal)
-> (TsRow -> Principal -> TsRow) -> Lens' TsRow Principal
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TsRow -> Principal
getter TsRow -> Principal -> TsRow
setter 
  where 
    getter :: TsRow -> Principal
getter (BondFlow Date
_ Principal
x Principal
_ Principal
_) = Principal
x
    getter (MortgageFlow Date
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
    getter (MortgageDelinqFlow Date
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
    getter (LoanFlow Date
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x
    getter (LeaseFlow Date
_ Principal
x Principal
_ Principal
_) = Principal
x
    getter (FixedFlow Date
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_) = Principal
x
    getter (ReceivableFlow Date
_ Principal
x Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Maybe CumulativeStat
_ ) = Principal
x

    setter :: TsRow -> Principal -> TsRow
setter (BondFlow Date
a Principal
_ Principal
p Principal
i) Principal
x = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
a Principal
x Principal
p Principal
i
    setter (MortgageFlow Date
a Principal
_ Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pn Maybe CumulativeStat
st) Principal
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
a Principal
x Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pn Maybe CumulativeStat
st
    setter (MortgageDelinqFlow Date
a Principal
_ Principal
p Principal
i Principal
prep Principal
delinq Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pn Maybe CumulativeStat
st) Principal
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
a Principal
x Principal
p Principal
i Principal
prep Principal
delinq Principal
def Principal
rec Principal
los IRate
rat Maybe Int
mbn Maybe Principal
pn Maybe CumulativeStat
st
    setter (LoanFlow Date
a Principal
_ Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe CumulativeStat
st) Principal
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
a Principal
x Principal
p Principal
i Principal
prep Principal
def Principal
rec Principal
los IRate
rat Maybe CumulativeStat
st
    setter (LeaseFlow Date
a Principal
_ Principal
r Principal
def) Principal
x = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
a Principal
x Principal
r Principal
def
    setter (FixedFlow Date
a Principal
_ Principal
b Principal
c Principal
d Principal
e) Principal
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
a Principal
x Principal
b Principal
c Principal
d Principal
e
    setter (ReceivableFlow Date
a Principal
_ Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h) Principal
x = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
a Principal
x Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Maybe CumulativeStat
h


mflowBegBalance :: TsRow -> Balance
mflowBegBalance :: TsRow -> Principal
mflowBegBalance (BondFlow Date
_ Principal
x Principal
p Principal
_) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p
mflowBegBalance (MortgageDelinqFlow Date
_ Principal
x Principal
p Principal
_ Principal
ppy Principal
delinq Principal
def Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
ppy Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
delinq
mflowBegBalance (MortgageFlow Date
_ Principal
x Principal
p Principal
_ Principal
ppy Principal
def Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
ppy Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def
mflowBegBalance (LoanFlow Date
_ Principal
x Principal
p Principal
_ Principal
ppy Principal
def Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
p Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
ppy Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def
mflowBegBalance (LeaseFlow Date
_ Principal
b Principal
r Principal
def ) = Principal
b Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
r Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def 
mflowBegBalance (FixedFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f ) = Principal
b Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
c
mflowBegBalance (ReceivableFlow Date
_ Principal
x Principal
_ Principal
b Principal
f Principal
def Principal
_ Principal
_ Maybe CumulativeStat
_) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
b Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
f

mflowLoss :: TsRow -> Balance
mflowLoss :: TsRow -> Principal
mflowLoss (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowLoss (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowLoss (LoanFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x IRate
_ Maybe CumulativeStat
_) = Principal
x
mflowLoss (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Maybe CumulativeStat
_ ) = Principal
x
mflowLoss TsRow
_ = Principal
0

mflowDelinq :: TsRow -> Balance
mflowDelinq :: TsRow -> Principal
mflowDelinq (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
x
mflowDelinq TsRow
_ = Principal
0

mflowRate :: TsRow -> IRate
-- ^ get rate(weigthed avg rate) for a cashflow record
mflowRate :: TsRow -> IRate
mflowRate (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
x Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = IRate
x
mflowRate (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
x Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = IRate
x
mflowRate (LoanFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
x Maybe CumulativeStat
_) = IRate
x
mflowRate (BondFlow Date
_ Principal
_ Principal
_ Principal
_) = IRate
0
mflowRate TsRow
_ = IRate
0

mflowRental :: TsRow -> Amount
mflowRental :: TsRow -> Principal
mflowRental (LeaseFlow Date
_ Principal
_ Principal
x Principal
_) = Principal
x
mflowRental TsRow
x = String -> Principal
forall a. HasCallStack => String -> a
error (String
"not support get rental from row"String -> ShowS
forall a. [a] -> [a] -> [a]
++TsRow -> String
forall a. Show a => a -> String
show TsRow
x)

mflowFeePaid :: TsRow -> Amount
mflowFeePaid :: TsRow -> Principal
mflowFeePaid (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_ Maybe CumulativeStat
_ ) = Principal
x
mflowFeePaid TsRow
_ = Principal
0

mflowAmortAmount :: TsRow -> Balance
-- ^ calculate amortized amount for cashflow (for defaults only)
mflowAmortAmount :: TsRow -> Principal
mflowAmortAmount (MortgageFlow Date
_ Principal
_ Principal
p Principal
_ Principal
ppy Principal
def Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
p Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
ppy Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def
mflowAmortAmount (MortgageDelinqFlow Date
_ Principal
_ Principal
p Principal
_ Principal
ppy Principal
delinq Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Principal
p Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
ppy Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
delinq
mflowAmortAmount (LoanFlow Date
_ Principal
_ Principal
x Principal
_ Principal
y Principal
z Principal
_ Principal
_ IRate
_ Maybe CumulativeStat
_) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
y Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
z
mflowAmortAmount (LeaseFlow Date
_ Principal
_ Principal
x Principal
def) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def
mflowAmortAmount (FixedFlow Date
_ Principal
_ Principal
x Principal
_ Principal
_ Principal
_) = Principal
x
mflowAmortAmount (BondFlow Date
_ Principal
_ Principal
p Principal
i) = Principal
p
mflowAmortAmount (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
x Principal
f Principal
def Principal
_ Principal
_ Maybe CumulativeStat
_ ) = Principal
x Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
def Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
f

mflowBorrowerNum :: TsRow -> Maybe BorrowerNum
-- ^ get borrower numfer for Mortgage Flow
mflowBorrowerNum :: TsRow -> Maybe Int
mflowBorrowerNum (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
x Maybe Principal
_ Maybe CumulativeStat
_) = Maybe Int
x
mflowBorrowerNum (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
x Maybe Principal
_ Maybe CumulativeStat
_) = Maybe Int
x
mflowBorrowerNum TsRow
_ = Maybe Int
forall a. HasCallStack => a
undefined

mflowPrepaymentPenalty :: TsRow -> Balance
-- ^ get prepayment penalty for a cashflow record
mflowPrepaymentPenalty :: TsRow -> Principal
mflowPrepaymentPenalty (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ (Just Principal
x) Maybe CumulativeStat
_) = Principal
x
mflowPrepaymentPenalty (MortgageFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
Nothing Maybe CumulativeStat
_) = Principal
0
mflowPrepaymentPenalty (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ (Just Principal
x) Maybe CumulativeStat
_) = Principal
x
mflowPrepaymentPenalty (MortgageDelinqFlow Date
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ Principal
_ IRate
_ Maybe Int
_ Maybe Principal
Nothing Maybe CumulativeStat
_) = Principal
0
mflowPrepaymentPenalty TsRow
_ = Principal
forall a. HasCallStack => a
undefined

-- tobe factor out alongside with similar funciton in bond cashflow
mflowWeightAverageBalance :: Date -> Date -> [TsRow] -> Balance
mflowWeightAverageBalance :: Date -> Date -> [TsRow] -> Principal
mflowWeightAverageBalance Date
sd Date
ed [TsRow]
trs
  = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ (Principal -> Rational -> Principal)
-> [Principal] -> [Rational] -> [Principal]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Principal -> Rational -> Principal
mulBR [Principal]
_bals [Rational]
_dfs  -- `debug` ("CalcingAvgBal=>"++show sd++show ed++show txns  )
    where
     txns :: [TsRow]
txns = (TsRow -> Bool) -> [TsRow] -> [TsRow]
forall a. (a -> Bool) -> [a] -> [a]
filter (\TsRow
x -> (Getting Date TsRow Date -> TsRow -> Date
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Date TsRow Date
Lens' TsRow Date
tsDate TsRow
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>=Date
sd)Bool -> Bool -> Bool
&& (Getting Date TsRow Date -> TsRow -> Date
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Date TsRow Date
Lens' TsRow Date
tsDate TsRow
x)Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<=Date
ed) [TsRow]
trs
     _ds :: [Date]
_ds = Getting Date TsRow Date -> TsRow -> Date
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Date TsRow Date
Lens' TsRow Date
tsDate (TsRow -> Date) -> [TsRow] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
txns -- `debug` ("fee base txns"++show txns)
     _bals :: [Principal]
_bals = (TsRow -> Principal) -> [TsRow] -> [Principal]
forall a b. (a -> b) -> [a] -> [b]
map TsRow -> Principal
mflowBegBalance [TsRow]
txns
     _dfs :: [Rational]
_dfs =  [Date] -> [Rational]
getIntervalFactors ([Date] -> [Rational]) -> [Date] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Date
sdDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[Date]
_ds

emptyTsRow :: Date -> TsRow -> TsRow 
-- ^ reset all cashflow fields to zero and init with a date
emptyTsRow :: Date -> TsRow -> TsRow
emptyTsRow Date
_d (MortgageDelinqFlow Date
a Principal
x Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
m) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
_d Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
0 Maybe Int
forall a. Maybe a
Nothing Maybe Principal
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing
emptyTsRow Date
_d (MortgageFlow Date
a Principal
x Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
_d Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
0 Maybe Int
forall a. Maybe a
Nothing Maybe Principal
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing
emptyTsRow Date
_d (LoanFlow Date
a Principal
x Principal
c Principal
d Principal
e Principal
f Principal
g Principal
i IRate
j Maybe CumulativeStat
k) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
_d Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
0 Maybe CumulativeStat
forall a. Maybe a
Nothing
emptyTsRow Date
_d (LeaseFlow Date
a Principal
x Principal
c Principal
d) = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
_d Principal
0 Principal
0 Principal
0
emptyTsRow Date
_d (FixedFlow Date
a Principal
x Principal
c Principal
d Principal
e Principal
f ) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
_d Principal
0 Principal
0 Principal
0 Principal
0 Principal
0
emptyTsRow Date
_d (BondFlow Date
a Principal
x Principal
c Principal
d) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
_d Principal
0 Principal
0 Principal
0
emptyTsRow Date
_d (ReceivableFlow Date
a Principal
x Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Maybe CumulativeStat
i) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
_d Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Maybe CumulativeStat
forall a. Maybe a
Nothing

extendCashFlow :: Date -> CashFlowFrame -> CashFlowFrame
extendCashFlow :: Date -> CashFlowFrame -> CashFlowFrame
extendCashFlow Date
d (CashFlowFrame BeginStatus
st []) = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st []
extendCashFlow Date
d (CashFlowFrame BeginStatus
st [TsRow]
txns) 
    = let 
        lastRow :: TsRow
lastRow = [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
txns
        newTxn :: TsRow
newTxn = Date -> TsRow -> TsRow
emptyTsRow Date
d TsRow
lastRow
      in 
        BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st ([TsRow]
txns[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow
newTxn])


viewTsRow :: Date -> TsRow -> TsRow 
-- ^ take a snapshot of a record from record balance/stats and a new date
viewTsRow :: Date -> TsRow -> TsRow
viewTsRow Date
_d (MortgageDelinqFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
m) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
_d Principal
b Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
m
viewTsRow Date
_d (MortgageFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
_d Principal
b Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l
viewTsRow Date
_d (LoanFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
i IRate
j Maybe CumulativeStat
k) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
_d Principal
b Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
j Maybe CumulativeStat
k
viewTsRow Date
_d (LeaseFlow Date
a Principal
b Principal
c Principal
d) = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
_d Principal
b Principal
0 Principal
0
viewTsRow Date
_d (FixedFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f ) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
_d Principal
b Principal
0 Principal
0 Principal
0 Principal
0
viewTsRow Date
_d (BondFlow Date
a Principal
b Principal
c Principal
d) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
_d Principal
b Principal
0 Principal
0
viewTsRow Date
_d (ReceivableFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Maybe CumulativeStat
i) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
_d Principal
b Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Maybe CumulativeStat
i

-- ^ given a cashflow,build a new cf row with begin balance
buildBegTsRow :: Date -> TsRow -> TsRow
buildBegTsRow :: Date -> TsRow -> TsRow
buildBegTsRow Date
d flow :: TsRow
flow@FixedFlow{} = TsRow
flow
buildBegTsRow Date
d TsRow
tr = 
  let 
    r :: TsRow
r = ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance ((Getting Principal TsRow Principal -> TsRow -> Principal
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Principal TsRow Principal
Lens' TsRow Principal
tsRowBalance TsRow
tr) Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ TsRow -> Principal
mflowAmortAmount TsRow
tr) (Date -> TsRow -> TsRow
emptyTsRow Date
d TsRow
tr)
    rate :: IRate
rate = TsRow -> IRate
mflowRate TsRow
tr
  in
    IRate -> TsRow -> TsRow
tsSetRate IRate
rate TsRow
r

buildStartTsRow :: CashFlowFrame -> Maybe TsRow
buildStartTsRow :: CashFlowFrame -> Maybe TsRow
buildStartTsRow (CashFlowFrame (Principal
begBal,Date
begDate,Maybe Principal
accInt) []) = Maybe TsRow
forall a. Maybe a
Nothing
buildStartTsRow (CashFlowFrame (Principal
begBal,Date
begDate,Maybe Principal
accInt) (TsRow
txn:[TsRow]
txns)) = 
  let 
    rEmpty :: TsRow
rEmpty = Date -> TsRow -> TsRow
emptyTsRow Date
begDate TsRow
txn 
    r :: TsRow
r = ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance Principal
begBal TsRow
rEmpty
    rate :: IRate
rate = TsRow -> IRate
mflowRate TsRow
txn
  in
    TsRow -> Maybe TsRow
forall a. a -> Maybe a
Just (TsRow -> Maybe TsRow) -> TsRow -> Maybe TsRow
forall a b. (a -> b) -> a -> b
$ IRate -> TsRow -> TsRow
tsSetRate IRate
rate TsRow
r

tsSetRate :: IRate -> TsRow -> TsRow
tsSetRate :: IRate -> TsRow -> TsRow
tsSetRate IRate
_r (MortgageDelinqFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
m) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
_r Maybe Int
k Maybe Principal
l Maybe CumulativeStat
m
tsSetRate IRate
_r (MortgageFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
i Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h IRate
_r Maybe Int
j Maybe Principal
k Maybe CumulativeStat
l
tsSetRate IRate
_r (LoanFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
i IRate
j Maybe CumulativeStat
k) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
i IRate
_r Maybe CumulativeStat
k
tsSetRate IRate
_r (BondFlow Date
a Principal
b Principal
c Principal
d) = Date -> Principal -> Principal -> Principal -> TsRow
BondFlow Date
a Principal
b Principal
c Principal
d
tsSetRate IRate
_r (ReceivableFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Maybe CumulativeStat
i) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Maybe CumulativeStat
i
tsSetRate IRate
_r (LeaseFlow Date
a Principal
b Principal
c Principal
d) = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
a Principal
b Principal
c Principal
d
tsSetRate IRate
_r (FixedFlow {} ) = String -> TsRow
forall a. HasCallStack => String -> a
error String
"Not implement set rate for FixedFlow"
tsSetRate IRate
_ TsRow
_ = String -> TsRow
forall a. HasCallStack => String -> a
error String
"Not implement set rate for this type"


insertBegTsRow :: Date -> CashFlowFrame -> CashFlowFrame
insertBegTsRow :: Date -> CashFlowFrame -> CashFlowFrame
insertBegTsRow Date
d (CashFlowFrame BeginStatus
st []) = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st []
insertBegTsRow Date
d (CashFlowFrame BeginStatus
st (TsRow
txn:[TsRow]
txns))
  = let
      begRow :: TsRow
begRow = Date -> TsRow -> TsRow
buildBegTsRow Date
d TsRow
txn
    in 
      BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st (TsRow
begRowTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
txnTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
txns)


totalLoss :: CashFlowFrame -> Balance
totalLoss :: CashFlowFrame -> Principal
totalLoss (CashFlowFrame BeginStatus
_ [TsRow]
rs) = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowLoss (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
rs

totalDefault :: CashFlowFrame -> Balance
totalDefault :: CashFlowFrame -> Principal
totalDefault (CashFlowFrame BeginStatus
_ [TsRow]
rs) = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowDefault (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
rs

totalRecovery :: CashFlowFrame -> Balance
totalRecovery :: CashFlowFrame -> Principal
totalRecovery (CashFlowFrame BeginStatus
_ [TsRow]
rs) = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowRecovery (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
rs

totalPrincipal :: CashFlowFrame -> Balance
totalPrincipal :: CashFlowFrame -> Principal
totalPrincipal (CashFlowFrame BeginStatus
_ [TsRow]
rs) = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowPrincipal (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
rs

-- ^ merge two cashflow frame but no patching beg balance
mergePoolCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergePoolCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergePoolCf CashFlowFrame
cf (CashFlowFrame BeginStatus
_ []) = CashFlowFrame
cf
mergePoolCf (CashFlowFrame BeginStatus
_ []) CashFlowFrame
cf = CashFlowFrame
cf
-- first day of left is earlier than right one
mergePoolCf cf1 :: CashFlowFrame
cf1@(CashFlowFrame BeginStatus
st1 [TsRow]
txns1) cf2 :: CashFlowFrame
cf2@(CashFlowFrame BeginStatus
st2 [TsRow]
txns2) 
  | Date
startDate1 Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
startDate2 = CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergePoolCf CashFlowFrame
cf2 CashFlowFrame
cf1 
  | Bool
otherwise 
      = let 
          splitDate :: Date
splitDate = CashFlowFrame -> Date
firstDate CashFlowFrame
cf2  -- (ls,rs) = splitByDate txns d st
          ([TsRow]
txn0,[TsRow]
txnToMerged) = [TsRow] -> Date -> SplitType -> ([TsRow], [TsRow])
forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [TsRow]
txns1 Date
splitDate SplitType
EqToRight
          txn1 :: [TsRow]
txn1 = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss [] [TsRow]
txnToMerged [TsRow]
txns2 -- `debug` ("left"++show cfToBeMerged++">> right"++ show cf2)
        in 
          BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st1 ([TsRow]
txn0[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow]
txn1) -- `debug` ("Txn1"++show txn1)
  where 
    [Date
startDate1,Date
startDate2] = CashFlowFrame -> Date
firstDate (CashFlowFrame -> Date) -> [CashFlowFrame] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CashFlowFrame
cf1,CashFlowFrame
cf2]


-- ^ agg cashflow (but not updating the cumulative stats)
aggTs :: [TsRow] -> [TsRow] -> [TsRow]
-- ^ short circuit
aggTs :: [TsRow] -> [TsRow] -> [TsRow]
aggTs [] [] = []
-- ^ return result update the cumulative stats
aggTs [TsRow]
rs [] = [TsRow]
rs 
-- ^ init with the first row
aggTs [] (TsRow
r:[TsRow]
rs) = [TsRow] -> [TsRow] -> [TsRow]
aggTs [TsRow
r] [TsRow]
rs
aggTs (TsRow
r:[TsRow]
rs) (TsRow
tr:[TsRow]
trs) 
  | TsRow -> TsRow -> Bool
forall ts. TimeSeries ts => ts -> ts -> Bool
sameDate TsRow
r TsRow
tr = [TsRow] -> [TsRow] -> [TsRow]
aggTs (TsRow -> TsRow -> TsRow
addTs TsRow
r TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs) [TsRow]
trs
  | Bool
otherwise = [TsRow] -> [TsRow] -> [TsRow]
aggTs (TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:TsRow
rTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs) [TsRow]
trs 


patchBalance :: (Balance,Maybe CumulativeStat) -> [TsRow] -> [TsRow] -> [TsRow]
patchBalance :: (Principal, Maybe CumulativeStat) -> [TsRow] -> [TsRow] -> [TsRow]
patchBalance (Principal
bal,Maybe CumulativeStat
stat) [] [] = []
patchBalance (Principal
bal,Maybe CumulativeStat
mStat) [TsRow]
r [] = case Maybe CumulativeStat
mStat of 
                                  Just CumulativeStat
stat -> CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
stat [] ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
r
                                  Maybe CumulativeStat
Nothing -> CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0) [] ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
r
patchBalance (Principal
bal,Maybe CumulativeStat
stat) [TsRow]
r (TsRow
tr:[TsRow]
trs) = 
  let 
    amortAmt :: Principal
amortAmt = TsRow -> Principal
mflowAmortAmount TsRow
tr
    newBal :: Principal
newBal = Principal
bal Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
amortAmt
    rWithUpdatedBal :: TsRow
rWithUpdatedBal = ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance Principal
newBal TsRow
tr
  in 
    (Principal, Maybe CumulativeStat) -> [TsRow] -> [TsRow] -> [TsRow]
patchBalance (Principal
newBal,Maybe CumulativeStat
stat) (TsRow
rWithUpdatedBalTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
r) [TsRow]
trs

-- type CumulativeStat = (CumPrincipal,CumPrepay,CumDelinq,CumDefault,CumRecovery,CumLoss)
-- 
calcBeginStats :: Maybe CumulativeStat -> TsRow -> CumulativeStat
calcBeginStats :: Maybe CumulativeStat -> TsRow -> CumulativeStat
calcBeginStats Maybe CumulativeStat
Nothing TsRow
tr = (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0)
calcBeginStats (Just (Principal
cumPrin,Principal
cumPrepay,Principal
cumDlinq,Principal
cumDef,Principal
cumRec,Principal
cumLoss)) TsRow
tr
  = case TsRow
tr of 
      (MortgageFlow Date
_ Principal
_ Principal
p Principal
_ Principal
ppy Principal
def Principal
rec Principal
los IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) -> 
        (Principal
cumPrin Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
p,Principal
cumPrepay Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
ppy, Principal
0 , Principal
cumDef Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
def, Principal
cumRec Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
rec , Principal
cumLoss Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
los)
      (MortgageDelinqFlow Date
_ Principal
_ Principal
p Principal
_ Principal
ppy Principal
delinq Principal
def Principal
rec Principal
los IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) -> 
        (Principal
cumPrin Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
p,Principal
cumPrepay Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
ppy, Principal
cumDlinq Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
delinq , Principal
cumDef Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
def, Principal
cumRec Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
rec , Principal
cumLoss Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
los)
      (LoanFlow Date
_ Principal
_ Principal
p Principal
_ Principal
ppy Principal
def Principal
rec Principal
los IRate
_ Maybe CumulativeStat
_) -> 
        (Principal
cumPrin Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
p,Principal
cumPrepay Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
ppy, Principal
0 , Principal
cumDef Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
def, Principal
cumRec Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
rec , Principal
cumLoss Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
los)
      (ReceivableFlow Date
_ Principal
_ Principal
_ Principal
p Principal
f Principal
def Principal
rec Principal
los Maybe CumulativeStat
_) -> 
        (Principal
cumPrin Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
p, Principal
0 , Principal
0 , Principal
cumDef Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
def, Principal
cumRec Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
rec , Principal
cumLoss Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
los)
      (BondFlow Date
_ Principal
_ Principal
p Principal
i) -> 
        (Principal
cumPrin Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
p,Principal
0 , Principal
0 , Principal
0, Principal
0, Principal
0)
      (LeaseFlow Date
_ Principal
b Principal
r Principal
def ) -> 
        (Principal
cumPrin Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
r,Principal
0 , Principal
0, Principal
cumDef Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
- Principal
def, Principal
0, Principal
0)
      (FixedFlow Date
_ Principal
b Principal
c Principal
d Principal
e Principal
_ ) -> (Principal
0, Principal
0 ,Principal
0 , Principal
0, Principal
0, Principal
0)
      (CashFlow Date
_ Principal
amt) -> (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0)


getCfBegStats :: CashFlowFrame -> CumulativeStat
getCfBegStats :: CashFlowFrame -> CumulativeStat
getCfBegStats (CashFlowFrame BeginStatus
_ []) = (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0)
getCfBegStats (CashFlowFrame BeginStatus
_ (TsRow
tr:[TsRow]
trs)) = Maybe CumulativeStat -> TsRow -> CumulativeStat
calcBeginStats (Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
-> TsRow -> Maybe CumulativeStat
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
Lens' TsRow (Maybe CumulativeStat)
tsCumulative TsRow
tr) TsRow
tr


mergePoolCf2 :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergePoolCf2 :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergePoolCf2 CashFlowFrame
cf (CashFlowFrame BeginStatus
_ []) = CashFlowFrame
cf
mergePoolCf2 (CashFlowFrame BeginStatus
_ []) CashFlowFrame
cf = CashFlowFrame
cf
mergePoolCf2 cf1 :: CashFlowFrame
cf1@(CashFlowFrame st1 :: BeginStatus
st1@(Principal
bBal1,Date
bDate1,Maybe Principal
a1) [TsRow]
txns1) cf2 :: CashFlowFrame
cf2@(CashFlowFrame (Principal
bBal2,Date
bDate2,Maybe Principal
a2) [TsRow]
txns2) 
  | [TsRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TsRow]
txns2 = ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
cashflowTxn ((Principal, Maybe CumulativeStat) -> [TsRow] -> [TsRow] -> [TsRow]
patchBalance (Principal
bBal1,[TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
txns1 TsRow
-> Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
-> Maybe CumulativeStat
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
Lens' TsRow (Maybe CumulativeStat)
tsCumulative) []) CashFlowFrame
cf1
  | Date
bDate1 Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
bDate2 = CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergePoolCf2 CashFlowFrame
cf2 CashFlowFrame
cf1
  -- both cashflow frame start on the same day OR left one starts earlier than right one
  -- 20241021:why? | bDate1 == bDate2 && bBal2 == 0 = over cashflowTxn (patchBalance bBal1 []) cf1
  | Date
bDate1 Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== Date
bDate2 Bool -> Bool -> Bool
&& Principal
bBal2 Principal -> Principal -> Bool
forall a. Eq a => a -> a -> Bool
== Principal
0 = CashFlowFrame
cf1
  | Date
bDate1 Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== Date
bDate2 = 
    let 
      begBal :: Principal
begBal = Principal
bBal1 Principal -> Principal -> Principal
forall a. Num a => a -> a -> a
+ Principal
bBal2
      
      begStat :: Maybe CumulativeStat
begStat = Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats (CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just (CashFlowFrame -> CumulativeStat
getCfBegStats CashFlowFrame
cf1)) (CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just (CashFlowFrame -> CumulativeStat
getCfBegStats CashFlowFrame
cf2))
      txnsSorted :: [TsRow]
txnsSorted = [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ (TsRow -> Date) -> [TsRow] -> [TsRow]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ([TsRow]
txns1 [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
txns2)
      txnAggregated :: [TsRow]
txnAggregated = [TsRow] -> [TsRow] -> [TsRow]
aggTs [] [TsRow]
txnsSorted
      txnPatchedBalance :: [TsRow]
txnPatchedBalance = (Principal, Maybe CumulativeStat) -> [TsRow] -> [TsRow] -> [TsRow]
patchBalance (Principal
begBal,Maybe CumulativeStat
begStat) [] [TsRow]
txnAggregated -- `debug` ("\n Pathcing with stat"++ show begStat)
    in 
      BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame (Principal
begBal, Date
bDate1, Maybe Principal
a1) [TsRow]
txnPatchedBalance
  | Bool
otherwise 
      = let 
          (CashFlowFrame
resultCf1, CashFlowFrame
cfToCombine) = CashFlowFrame
-> Date -> SplitType -> (CashFlowFrame, CashFlowFrame)
splitCashFlowFrameByDate CashFlowFrame
cf1 Date
bDate2 SplitType
EqToRight 
          (CashFlowFrame BeginStatus
_ [TsRow]
txnCombined) = CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergePoolCf2 CashFlowFrame
cfToCombine CashFlowFrame
cf2
        in 
          ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
cashflowTxn ([TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [TsRow]
txnCombined) CashFlowFrame
resultCf1 


mergeCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergeCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame
mergeCf CashFlowFrame
cf (CashFlowFrame BeginStatus
_ []) = CashFlowFrame
cf
mergeCf (CashFlowFrame BeginStatus
_ []) CashFlowFrame
cf = CashFlowFrame
cf
mergeCf cf1 :: CashFlowFrame
cf1@(CashFlowFrame (Principal
begBal1,Date
begDate1,Maybe Principal
mAccInt1) [TsRow]
txns1) cf2 :: CashFlowFrame
cf2@(CashFlowFrame (Principal
begBal2,Date
begDate2,Maybe Principal
mAccInt2)[TsRow]
txns2) -- first day of left is earlier than right one
  = let 
      mSrow1 :: Maybe TsRow
mSrow1 = CashFlowFrame -> Maybe TsRow
buildStartTsRow CashFlowFrame
cf1
      mSrow2 :: Maybe TsRow
mSrow2 = CashFlowFrame -> Maybe TsRow
buildStartTsRow CashFlowFrame
cf2
      txns1' :: [TsRow]
txns1' = case Maybe TsRow
mSrow1 of
                  Maybe TsRow
Nothing -> [TsRow]
txns1
                  Just TsRow
srow1 -> TsRow
srow1TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
txns1
      txns2' :: [TsRow]
txns2' = case Maybe TsRow
mSrow2 of
                  Maybe TsRow
Nothing -> [TsRow]
txns2
                  Just TsRow
srow2 -> TsRow
srow2TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
txns2
      txns :: [TsRow]
txns = [TsRow] -> [TsRow] -> [TsRow] -> [TsRow]
combineTss [] [TsRow]
txns1' [TsRow]
txns2'
      newSt :: BeginStatus
newSt = if Date
begDate1 Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
begDate2 then (Principal
begBal1,Date
begDate1,Maybe Principal
mAccInt1) else (Principal
begBal2,Date
begDate2,Maybe Principal
mAccInt2)
    in 
      BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
newSt [TsRow]
txns


consolidateCashFlow :: CashFlowFrame -> CashFlowFrame
consolidateCashFlow :: CashFlowFrame -> CashFlowFrame
consolidateCashFlow (CashFlowFrame BeginStatus
st []) = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st []
consolidateCashFlow (CashFlowFrame BeginStatus
st (TsRow
txn:[TsRow]
txns))
  = let 
      totalBals :: Principal
totalBals = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowAmortAmount (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TsRow
txnTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
txns)
    in 
      BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st (ASetter TsRow TsRow Principal Principal
-> Principal -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow Principal Principal
Lens' TsRow Principal
tsRowBalance Principal
totalBals TsRow
txnTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
txns)
    

shiftCfToStartDate :: Date -> CashFlowFrame -> CashFlowFrame
shiftCfToStartDate :: Date -> CashFlowFrame -> CashFlowFrame
shiftCfToStartDate Date
d cf :: CashFlowFrame
cf@(CashFlowFrame BeginStatus
st (TsRow
txn:[TsRow]
txns))
  = let 
      fstDate :: Date
fstDate = CashFlowFrame -> Date
firstDate CashFlowFrame
cf 
      diffDays :: Integer
diffDays = Date -> Date -> Integer
daysBetween Date
fstDate Date
d
    in 
      BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ Integer -> TsRow -> TsRow
tsOffsetDate Integer
diffDays (TsRow -> TsRow) -> [TsRow] -> [TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TsRow
txnTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
txns)

-- ^ sum a single pool source from a cashflow frame
sumPoolFlow :: CashFlowFrame -> PoolSource -> Balance
sumPoolFlow :: CashFlowFrame -> PoolSource -> Principal
sumPoolFlow (CashFlowFrame BeginStatus
_ [TsRow]
trs) PoolSource
ps 
  = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ (TsRow -> PoolSource -> Principal
`lookupSource` PoolSource
ps) (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
trs

-- ^ lookup a pool source from a row
lookupSource :: TsRow -> PoolSource -> Balance 
lookupSource :: TsRow -> PoolSource -> Principal
lookupSource TsRow
tr PoolSource
CollectedPrepayment  = TsRow -> Principal
mflowPrepayment TsRow
tr
lookupSource TsRow
tr PoolSource
CollectedPrincipal = TsRow -> Principal
mflowPrincipal TsRow
tr
lookupSource TsRow
tr PoolSource
CollectedRecoveries = TsRow -> Principal
mflowRecovery TsRow
tr
lookupSource TsRow
tr PoolSource
CollectedRental = TsRow -> Principal
mflowRental TsRow
tr
lookupSource TsRow
tr PoolSource
CollectedInterest = TsRow -> Principal
mflowInterest TsRow
tr
lookupSource TsRow
tr PoolSource
CollectedPrepaymentPenalty = TsRow -> Principal
mflowPrepaymentPenalty TsRow
tr
lookupSource TsRow
tr PoolSource
CollectedFeePaid = TsRow -> Principal
mflowFeePaid TsRow
tr
lookupSource TsRow
tr PoolSource
CollectedCash = TsRow -> Principal
tsTotalCash TsRow
tr
lookupSource TsRow
tr PoolSource
NewDelinquencies = TsRow -> Principal
mflowDelinq TsRow
tr
lookupSource TsRow
tr PoolSource
NewDefaults = TsRow -> Principal
mflowDefault TsRow
tr
lookupSource TsRow
tr PoolSource
NewLosses = TsRow -> Principal
mflowLoss TsRow
tr
lookupSource TsRow
tr PoolSource
CurBalance = Getting Principal TsRow Principal -> TsRow -> Principal
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Principal TsRow Principal
Lens' TsRow Principal
tsRowBalance TsRow
tr
lookupSource TsRow
tr PoolSource
CurBegBalance = TsRow -> Principal
mflowBegBalance TsRow
tr
lookupSource TsRow
tr PoolSource
x = String -> Principal
forall a. HasCallStack => String -> a
error (String
"Failed to lookup source"String -> ShowS
forall a. [a] -> [a] -> [a]
++ PoolSource -> String
forall a. Show a => a -> String
show PoolSource
x)

lookupSourceM :: Balance -> Maybe TsRow -> PoolSource -> Balance
lookupSourceM :: Principal -> Maybe TsRow -> PoolSource -> Principal
lookupSourceM Principal
bal Maybe TsRow
Nothing PoolSource
CurBegBalance = Principal
bal
lookupSourceM Principal
bal Maybe TsRow
Nothing PoolSource
CurBalance = Principal
bal
lookupSourceM Principal
_ Maybe TsRow
Nothing PoolSource
_ = Principal
0
lookupSourceM Principal
_ (Just TsRow
tr) PoolSource
ps = TsRow -> PoolSource -> Principal
lookupSource TsRow
tr PoolSource
ps


setPrepaymentPenalty :: Balance -> TsRow -> TsRow
setPrepaymentPenalty :: Principal -> TsRow -> TsRow
setPrepaymentPenalty Principal
bal (MortgageDelinqFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
m) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k (Principal -> Maybe Principal
forall a. a -> Maybe a
Just Principal
bal) Maybe CumulativeStat
m
setPrepaymentPenalty Principal
bal (MortgageFlow Date
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k Maybe Principal
l Maybe CumulativeStat
m) = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Principal
i IRate
j Maybe Int
k (Principal -> Maybe Principal
forall a. a -> Maybe a
Just Principal
bal) Maybe CumulativeStat
m
setPrepaymentPenalty Principal
_ TsRow
_ = String -> TsRow
forall a. HasCallStack => String -> a
error String
"prepay pental only applies to MortgageFlow"

setPrepaymentPenaltyFlow :: [Balance] -> [TsRow] -> [TsRow]
setPrepaymentPenaltyFlow :: [Principal] -> [TsRow] -> [TsRow]
setPrepaymentPenaltyFlow [Principal]
bals [TsRow]
trs = [ Principal -> TsRow -> TsRow
setPrepaymentPenalty Principal
bal TsRow
tr | (Principal
bal,TsRow
tr) <- [Principal] -> [TsRow] -> [(Principal, TsRow)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Principal]
bals [TsRow]
trs]


-- ^ split single cashflow record by a rate
splitTs :: Rate -> TsRow -> TsRow 
splitTs :: Rational -> TsRow -> TsRow
splitTs Rational
r (MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d (Principal -> Rational -> Principal
mulBR Principal
bal Rational
r) (Principal -> Rational -> Principal
mulBR Principal
p Rational
r) (Principal -> Rational -> Principal
mulBR Principal
i Rational
r) (Principal -> Rational -> Principal
mulBR Principal
ppy Rational
r)
                       (Principal -> Rational -> Principal
mulBR Principal
delinq Rational
r) (Principal -> Rational -> Principal
mulBR Principal
def Rational
r) (Principal -> Rational -> Principal
mulBR Principal
recovery Rational
r) (Principal -> Rational -> Principal
mulBR Principal
loss Rational
r)
                       IRate
rate ((\Int
x -> Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mB) ((Principal -> Rational -> Principal
`mulBR` Rational
r) (Principal -> Principal) -> Maybe Principal -> Maybe Principal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
mPPN)
                       (Rational -> CumulativeStat -> CumulativeStat
splitStats Rational
r (CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> Maybe CumulativeStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CumulativeStat
mStat)
splitTs Rational
r (MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d (Principal -> Rational -> Principal
mulBR Principal
bal Rational
r) (Principal -> Rational -> Principal
mulBR Principal
p Rational
r) (Principal -> Rational -> Principal
mulBR Principal
i Rational
r) (Principal -> Rational -> Principal
mulBR Principal
ppy Rational
r)
                       (Principal -> Rational -> Principal
mulBR Principal
def Rational
r) (Principal -> Rational -> Principal
mulBR Principal
recovery Rational
r) (Principal -> Rational -> Principal
mulBR Principal
loss Rational
r)
                       IRate
rate ((\Int
x -> Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mB) ((Principal -> Rational -> Principal
`mulBR` Rational
r) (Principal -> Principal) -> Maybe Principal -> Maybe Principal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
mPPN)
                       (Rational -> CumulativeStat -> CumulativeStat
splitStats Rational
r (CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> Maybe CumulativeStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CumulativeStat
mStat)
splitTs Rational
r (LeaseFlow Date
d Principal
bal Principal
p Principal
def)
  = Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
d (Principal -> Rational -> Principal
mulBR Principal
bal Rational
r) (Principal -> Rational -> Principal
mulBR Principal
p Rational
r) (Principal -> Rational -> Principal
mulBR Principal
def Rational
r)
splitTs Rational
_ TsRow
tr = String -> TsRow
forall a. HasCallStack => String -> a
error (String -> TsRow) -> String -> TsRow
forall a b. (a -> b) -> a -> b
$ String
"Not support for spliting TsRow"String -> ShowS
forall a. [a] -> [a] -> [a]
++TsRow -> String
forall a. Show a => a -> String
show TsRow
tr

splitTrs :: Rate -> [TsRow] -> [TsRow]
splitTrs :: Rational -> [TsRow] -> [TsRow]
splitTrs Rational
r [TsRow]
trs = Rational -> TsRow -> TsRow
splitTs Rational
r (TsRow -> TsRow) -> [TsRow] -> [TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
trs 

splitCf :: Rate -> CashFlowFrame -> CashFlowFrame
splitCf :: Rational -> CashFlowFrame -> CashFlowFrame
splitCf Rational
1 CashFlowFrame
cf = CashFlowFrame
cf
splitCf Rational
r (CashFlowFrame BeginStatus
st []) = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st []
splitCf Rational
r (CashFlowFrame (Principal
begBal, Date
begDate, Maybe Principal
mAccInt) [TsRow]
trs) 
  = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame (Principal -> Rational -> Principal
mulBR Principal
begBal Rational
r, Date
begDate, (Principal -> Rational -> Principal
`mulBR` Rational
r) (Principal -> Principal) -> Maybe Principal -> Maybe Principal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Principal
mAccInt) ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ Rational -> [TsRow] -> [TsRow]
splitTrs Rational
r [TsRow]
trs -- `debug` ("split by rate"++ show (fromRational r))

currentCumulativeStat :: [TsRow] -> CumulativeStat
currentCumulativeStat :: [TsRow] -> CumulativeStat
currentCumulativeStat [] = (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0)
currentCumulativeStat [TsRow]
trs = 
  let 
    tr :: TsRow
tr = [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
trs
  in 
    CumulativeStat -> Maybe CumulativeStat -> CumulativeStat
forall a. a -> Maybe a -> a
fromMaybe (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0) (Maybe CumulativeStat -> CumulativeStat)
-> Maybe CumulativeStat -> CumulativeStat
forall a b. (a -> b) -> a -> b
$ Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
-> TsRow -> Maybe CumulativeStat
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
Lens' TsRow (Maybe CumulativeStat)
txnCumulativeStats TsRow
tr


cashFlowInitCumulativeStats ::  Lens' CashFlowFrame (Maybe CumulativeStat)
cashFlowInitCumulativeStats :: Lens' CashFlowFrame (Maybe CumulativeStat)
cashFlowInitCumulativeStats = (CashFlowFrame -> Maybe CumulativeStat)
-> (CashFlowFrame -> Maybe CumulativeStat -> CashFlowFrame)
-> Lens' CashFlowFrame (Maybe CumulativeStat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CashFlowFrame -> Maybe CumulativeStat
getter CashFlowFrame -> Maybe CumulativeStat -> CashFlowFrame
setter 
  where
    getter :: CashFlowFrame -> Maybe CumulativeStat
getter (CashFlowFrame BeginStatus
_ []) = Maybe CumulativeStat
forall a. Maybe a
Nothing
    getter (CashFlowFrame BeginStatus
_ (TsRow
tr:[TsRow]
trs)) = Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
-> TsRow -> Maybe CumulativeStat
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe CumulativeStat) TsRow (Maybe CumulativeStat)
Lens' TsRow (Maybe CumulativeStat)
txnCumulativeStats TsRow
tr
    
    setter :: CashFlowFrame -> Maybe CumulativeStat -> CashFlowFrame
setter (CashFlowFrame BeginStatus
st []) Maybe CumulativeStat
mStat = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st []
    setter (CashFlowFrame BeginStatus
st (TsRow
tr:[TsRow]
trs)) Maybe CumulativeStat
mStat = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (ASetter TsRow TsRow (Maybe CumulativeStat) (Maybe CumulativeStat)
-> Maybe CumulativeStat -> TsRow -> TsRow
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TsRow TsRow (Maybe CumulativeStat) (Maybe CumulativeStat)
Lens' TsRow (Maybe CumulativeStat)
txnCumulativeStats Maybe CumulativeStat
mStat TsRow
tr)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs


patchCumulativeAtInit :: Maybe CumulativeStat -> [TsRow] -> [TsRow]
patchCumulativeAtInit :: Maybe CumulativeStat -> [TsRow] -> [TsRow]
patchCumulativeAtInit Maybe CumulativeStat
_ [] = []
patchCumulativeAtInit Maybe CumulativeStat
mStatsInit (MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat:[TsRow]
trs)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
mStat Maybe CumulativeStat
mStatsInit)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs
patchCumulativeAtInit Maybe CumulativeStat
mStatsInit (MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat:[TsRow]
trs)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
mStat Maybe CumulativeStat
mStatsInit)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs
patchCumulativeAtInit Maybe CumulativeStat
mStatsInit (LoanFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe CumulativeStat
mStat:[TsRow]
trs)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
mStat Maybe CumulativeStat
mStatsInit)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs
patchCumulativeAtInit Maybe CumulativeStat
mStatsInit (ReceivableFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss Maybe CumulativeStat
mStat:[TsRow]
trs)
  = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss (Maybe CumulativeStat
-> Maybe CumulativeStat -> Maybe CumulativeStat
sumStats Maybe CumulativeStat
mStat Maybe CumulativeStat
mStatsInit)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs
patchCumulativeAtInit Maybe CumulativeStat
_ [TsRow]
trs = [TsRow]
trs


patchCumulative :: CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative :: CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
_ [TsRow]
rs [] = [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
rs
patchCumulative (Principal
cPrin,Principal
cPrepay,Principal
cDelinq,Principal
cDefault,Principal
cRecovery,Principal
cLoss)
                [TsRow]
rs
                (MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
_:[TsRow]
trs)
  = CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
newSt
                    (Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN (CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just CumulativeStat
newSt)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs)
                    [TsRow]
trs
                 where 
                   newSt :: CumulativeStat
newSt = (Principal
cPrinPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
p,Principal
cPrepayPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
ppy,Principal
cDelinqPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
delinq,Principal
cDefaultPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
def,Principal
cRecoveryPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
recovery,Principal
cLossPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
loss)
patchCumulative (Principal
cPrin,Principal
cPrepay,Principal
cDelinq,Principal
cDefault,Principal
cRecovery,Principal
cLoss)
               [TsRow]
rs
               ((MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
_):[TsRow]
trs)
  = CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
newSt
                   (Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN (CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just CumulativeStat
newSt)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs)
                   [TsRow]
trs
                where 
                  newSt :: CumulativeStat
newSt = (Principal
cPrinPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
p,Principal
cPrepayPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
ppy,Principal
cDelinq,Principal
cDefaultPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
def,Principal
cRecoveryPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
recovery,Principal
cLossPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
loss)
patchCumulative (Principal
cPrin,Principal
cPrepay,Principal
cDelinq,Principal
cDefault,Principal
cRecovery,Principal
cLoss)
              [TsRow]
rs
              ((LoanFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe CumulativeStat
_):[TsRow]
trs)
  = CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
newSt
                  (Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate (CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just CumulativeStat
newSt)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs)
                  [TsRow]
trs
               where 
                 newSt :: CumulativeStat
newSt = (Principal
cPrinPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
p,Principal
cPrepayPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
ppy,Principal
cDelinq,Principal
cDefaultPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
def,Principal
cRecoveryPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
recovery,Principal
cLossPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
loss)

patchCumulative (Principal
cPrin,Principal
cPrepay,Principal
cDelinq,Principal
cDefault,Principal
cRecovery,Principal
cLoss)
              [TsRow]
rs
              ((FixedFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f):[TsRow]
trs)
  = CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
newSt
                  (Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> TsRow
FixedFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
fTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs)
                  [TsRow]
trs
               where 
                 newSt :: CumulativeStat
newSt = (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0)

patchCumulative (Principal
cPrin,Principal
cPrepay,Principal
cDelinq,Principal
cDefault,Principal
cRecovery,Principal
cLoss)
              [TsRow]
rs
              ((ReceivableFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h Maybe CumulativeStat
i):[TsRow]
trs)
  = CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
newSt
                  (Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
a Principal
b Principal
c Principal
d Principal
e Principal
f Principal
g Principal
h (CumulativeStat -> Maybe CumulativeStat
forall a. a -> Maybe a
Just CumulativeStat
newSt)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs)
                  [TsRow]
trs
               where
                 newSt :: CumulativeStat
newSt = (Principal
cPrinPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
c,Principal
0,Principal
0,Principal
cDefaultPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
f,Principal
cRecoveryPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
g,Principal
cLossPrincipal -> Principal -> Principal
forall a. Num a => a -> a -> a
+Principal
h)

patchCumulative (Principal
cPrin,Principal
cPrepay,Principal
cDelinq,Principal
cDefault,Principal
cRecovery,Principal
cLoss)
              [TsRow]
rs
              ((LeaseFlow Date
a Principal
b Principal
c Principal
d) :[TsRow]
trs)
  = CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative CumulativeStat
newSt
                  (Date -> Principal -> Principal -> Principal -> TsRow
LeaseFlow Date
a Principal
b Principal
c Principal
dTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs)
                  [TsRow]
trs
               where
                 newSt :: CumulativeStat
newSt = (Principal
0,Principal
0,Principal
0,Principal
0,Principal
0,Principal
0)

patchCumulative CumulativeStat
a [TsRow]
b [TsRow]
c = String -> [TsRow]
forall a. HasCallStack => String -> a
error (String
"failed to patch cumulative stats for "String -> ShowS
forall a. [a] -> [a] -> [a]
++CumulativeStat -> String
forall a. Show a => a -> String
show CumulativeStat
a String -> ShowS
forall a. [a] -> [a] -> [a]
++String
">>"String -> ShowS
forall a. [a] -> [a] -> [a]
++[TsRow] -> String
forall a. Show a => a -> String
show [TsRow]
bString -> ShowS
forall a. [a] -> [a] -> [a]
++String
">>"String -> ShowS
forall a. [a] -> [a] -> [a]
++[TsRow] -> String
forall a. Show a => a -> String
show [TsRow]
c)



-- ^ split cashflow by rate while build missing defaults/losses stats
cutoffTrs :: Date -> [TsRow] -> ([TsRow],Map.Map CutoffFields Balance)
cutoffTrs :: Date -> [TsRow] -> ([TsRow], Map CutoffFields Principal)
cutoffTrs Date
d [] = ([],Map CutoffFields Principal
forall k a. Map k a
Map.empty)
cutoffTrs Date
d [TsRow]
trs 
  = let 
      beforeTrs :: [TsRow]
beforeTrs = CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Exc DateDirection
Past Date
d [TsRow]
trs
      cumuDefaults :: Principal
cumuDefaults = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowDefault (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
beforeTrs 
      cumuDelinquency :: Principal
cumuDelinquency = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowDelinq (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
beforeTrs  
      cumuLoss :: Principal
cumuLoss = [Principal] -> Principal
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Principal] -> Principal) -> [Principal] -> Principal
forall a b. (a -> b) -> a -> b
$ TsRow -> Principal
mflowLoss (TsRow -> Principal) -> [TsRow] -> [Principal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
beforeTrs 
      m :: Map CutoffFields Principal
m = [(CutoffFields, Principal)] -> Map CutoffFields Principal
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CutoffFields
HistoryDefaults,Principal
cumuDefaults),(CutoffFields
HistoryDelinquency,Principal
cumuDelinquency),(CutoffFields
HistoryLoss,Principal
cumuLoss)]
      
      afterTrs :: [TsRow]
afterTrs  = CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Inc DateDirection
Future Date
d [TsRow]
trs
    in
      (CumulativeStat -> [TsRow] -> [TsRow] -> [TsRow]
patchCumulative (Principal
0.0,Principal
0.0,Principal
0.0,Principal
0.0,Principal
0.0,Principal
0.0) [] [TsRow]
afterTrs, Map CutoffFields Principal
m)

-- TODO need to fix accrue interest & cutoff stat
cutoffCashflow :: Date -> Dates -> CashFlowFrame -> CashFlowFrame
cutoffCashflow :: Date -> [Date] -> CashFlowFrame -> CashFlowFrame
cutoffCashflow Date
sd [Date]
ds (CashFlowFrame BeginStatus
st []) = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st []
cutoffCashflow Date
sd [Date]
ds (CashFlowFrame BeginStatus
st [TsRow]
txns) 
  = let 
      futureTxns :: [TsRow]
futureTxns = CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Inc DateDirection
Future Date
sd [TsRow]
txns
      withBegTs :: [TsRow] -> [TsRow]
withBegTs [] =  []
      withBegTs (TsRow
tr:[TsRow]
trs) = Date -> TsRow -> TsRow
buildBegTsRow Date
sd TsRow
trTsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
: TsRow
tr TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
trs 
      aggTxns :: [TsRow]
aggTxns = [TsRow] -> [Date] -> [TsRow]
aggTsByDates ([TsRow] -> [TsRow]
withBegTs [TsRow]
futureTxns) [Date]
ds
    in 
      BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame ([TsRow] -> Principal
buildBegBal [TsRow]
aggTxns, Date
sd, Maybe Principal
forall a. Maybe a
Nothing) [TsRow]
aggTxns 


extendTxns :: TsRow -> [Date] -> [TsRow]      
extendTxns :: TsRow -> [Date] -> [TsRow]
extendTxns TsRow
tr [Date]
ds = [ Date -> TsRow -> TsRow
emptyTsRow Date
d TsRow
tr | Date
d <- [Date]
ds ]

-- test emtpy cashflow row
isEmptyRow :: TsRow -> Bool 
isEmptyRow :: TsRow -> Bool
isEmptyRow (MortgageDelinqFlow Date
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Bool
True
isEmptyRow (MortgageFlow Date
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Bool
True
isEmptyRow (LoanFlow Date
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
i Maybe CumulativeStat
j ) = Bool
True
isEmptyRow (LeaseFlow Date
_ Principal
0 Principal
0 Principal
0) = Bool
True
isEmptyRow (FixedFlow Date
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0) = Bool
True
isEmptyRow (BondFlow Date
_ Principal
0 Principal
0 Principal
0) = Bool
True
isEmptyRow (CashFlow Date
_ Principal
0) = Bool
True
isEmptyRow (ReceivableFlow Date
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Maybe CumulativeStat
_ ) = Bool
True
isEmptyRow TsRow
_ = Bool
False

-- test emtpy cashflow row (ignore balance)
isEmptyRow2 :: TsRow -> Bool 
isEmptyRow2 :: TsRow -> Bool
isEmptyRow2 (MortgageDelinqFlow Date
_ Principal
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Bool
True
isEmptyRow2 (MortgageFlow Date
_ Principal
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
_ Maybe Int
_ Maybe Principal
_ Maybe CumulativeStat
_) = Bool
True
isEmptyRow2 (LoanFlow Date
_ Principal
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 IRate
i Maybe CumulativeStat
j ) = Bool
True
isEmptyRow2 (LeaseFlow Date
_ Principal
_ Principal
0 Principal
_) = Bool
True
isEmptyRow2 (FixedFlow Date
_ Principal
_ Principal
0 Principal
0 Principal
0 Principal
0) = Bool
True
isEmptyRow2 (BondFlow Date
_ Principal
_ Principal
0 Principal
0) = Bool
True
isEmptyRow2 (CashFlow Date
_ Principal
0) = Bool
True
isEmptyRow2 (ReceivableFlow Date
_ Principal
_ Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Principal
0 Maybe CumulativeStat
_ ) = Bool
True
isEmptyRow2 TsRow
_ = Bool
False

-- ^ Remove empty cashflow from the tail
dropTailEmptyTxns :: [TsRow] -> [TsRow]
dropTailEmptyTxns :: [TsRow] -> [TsRow]
dropTailEmptyTxns [TsRow]
trs 
  = [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ (TsRow -> Bool) -> [TsRow] -> [TsRow]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile TsRow -> Bool
isEmptyRow ([TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
trs)


cashflowTxn :: Lens' CashFlowFrame [TsRow]
cashflowTxn :: Lens' CashFlowFrame [TsRow]
cashflowTxn = (CashFlowFrame -> [TsRow])
-> (CashFlowFrame -> [TsRow] -> CashFlowFrame)
-> Lens' CashFlowFrame [TsRow]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CashFlowFrame -> [TsRow]
getter CashFlowFrame -> [TsRow] -> CashFlowFrame
setter
  where 
    getter :: CashFlowFrame -> [TsRow]
getter (CashFlowFrame BeginStatus
_ [TsRow]
txns) = [TsRow]
txns
    setter :: CashFlowFrame -> [TsRow] -> CashFlowFrame
setter (CashFlowFrame BeginStatus
st [TsRow]
txns) [TsRow]
newTxns = BeginStatus -> [TsRow] -> CashFlowFrame
CashFlowFrame BeginStatus
st [TsRow]
newTxns


txnCumulativeStats :: Lens' TsRow (Maybe CumulativeStat)
txnCumulativeStats :: Lens' TsRow (Maybe CumulativeStat)
txnCumulativeStats = (TsRow -> Maybe CumulativeStat)
-> (TsRow -> Maybe CumulativeStat -> TsRow)
-> Lens' TsRow (Maybe CumulativeStat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TsRow -> Maybe CumulativeStat
getter TsRow -> Maybe CumulativeStat -> TsRow
setter
  where 
    getter :: TsRow -> Maybe CumulativeStat
getter (MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter (MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter (LoanFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter (ReceivableFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss Maybe CumulativeStat
mStat) = Maybe CumulativeStat
mStat
    getter TsRow
_ = Maybe CumulativeStat
forall a. Maybe a
Nothing
    
    setter :: TsRow -> Maybe CumulativeStat -> TsRow
setter (MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
_) Maybe CumulativeStat
mStat 
      = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageDelinqFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
delinq Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat
    setter (MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
_) Maybe CumulativeStat
mStat
      = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe Int
-> Maybe Principal
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe Int
mB Maybe Principal
mPPN Maybe CumulativeStat
mStat
    setter (LoanFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe CumulativeStat
_) Maybe CumulativeStat
mStat
      = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> IRate
-> Maybe CumulativeStat
-> TsRow
LoanFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss IRate
rate Maybe CumulativeStat
mStat
    setter (ReceivableFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss Maybe CumulativeStat
_) Maybe CumulativeStat
mStat
      = Date
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Principal
-> Maybe CumulativeStat
-> TsRow
ReceivableFlow Date
d Principal
bal Principal
p Principal
i Principal
ppy Principal
def Principal
recovery Principal
loss Maybe CumulativeStat
mStat
    setter TsRow
x Maybe CumulativeStat
_ = TsRow
x

$(deriveJSON defaultOptions ''TsRow)
$(deriveJSON defaultOptions ''CashFlowFrame)