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

module AssetClass.Lease
  (Lease(..),projCashflow,updateOriginDate)
  where

import qualified Data.Time as T
import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals)
import qualified Assumptions as AP
import Asset
import Types hiding (getOriginDate)
import Lib
import Util
import DateUtil

import qualified Data.Map as Map
import Data.List
import Data.Aeson hiding (json)
import Data.Decimal
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import GHC.Generics
import Data.Maybe
import AssetClass.AssetBase
import qualified Analytics as AN

import Control.Lens hiding (element)
import Control.Lens.TH

import Debug.Trace
import qualified Assumptions as A
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 PeriodAmount = Balance
type CapRate = Rate
type RentChangeRate = Rate
type RentChangeCurve = Ts
type TermChangeRate = Rate
type DayGap = Int
type LastAccuredDate = Date


getNewRental :: AP.LeaseAssetRentAssump -> Date -> Date -> LeaseRateCalc -> (AP.LeaseAssetRentAssump, LeaseRateCalc)
-- by day rate
getNewRental :: LeaseAssetRentAssump
-> Date
-> Date
-> LeaseRateCalc
-> (LeaseAssetRentAssump, LeaseRateCalc)
getNewRental (AP.BaseAnnualRate Rate
r) Date
sd Date
ed (ByDayRate Amount
dr DatePattern
dp) 
  = (Rate -> LeaseAssetRentAssump
AP.BaseAnnualRate Rate
r
    , Amount -> DatePattern -> LeaseRateCalc
ByDayRate (Amount -> Rate -> Amount
mulBR Amount
dr (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+ DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
DC_ACT_365F Date
sd Date
ed Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate -> Rate
forall a. Fractional a => Rate -> a
fromRational Rate
r)) DatePattern
dp)
getNewRental (AP.BaseCurve Ts
rc) Date
sd Date
ed (ByDayRate Amount
dr DatePattern
dp) 
  = (Ts -> LeaseAssetRentAssump
AP.BaseCurve Ts
rc
    , Amount -> DatePattern -> LeaseRateCalc
ByDayRate (Amount -> Rate -> Amount
mulBR Amount
dr (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+ DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
DC_ACT_365F Date
sd Date
ed Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Ts -> CutoffType -> Date -> Rate
getValByDate Ts
rc CutoffType
Exc Date
ed)) DatePattern
dp)
getNewRental (AP.BaseByVec [Rate]
rs) Date
sd Date
ed (ByDayRate Amount
dr DatePattern
dp) 
  = let
      (Amount
newDr,[Rate]
nextRs) = case [Rate] -> Maybe (Rate, [Rate])
forall a. [a] -> Maybe (a, [a])
Data.List.uncons [Rate]
rs of 
                         Just (Rate
r,[Rate]
_rs) -> (Amount -> Rate -> Amount
mulBR Amount
dr (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+ DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
DC_ACT_365F Date
sd Date
ed Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate -> Rate
forall a. Fractional a => Rate -> a
fromRational Rate
r)
                                          , [Rate]
_rs)
                         Maybe (Rate, [Rate])
Nothing -> (Amount
dr,[Rate
0.0])
    in
      ([Rate] -> LeaseAssetRentAssump
AP.BaseByVec [Rate]
nextRs, Amount -> DatePattern -> LeaseRateCalc
ByDayRate Amount
newDr DatePattern
dp)

-- by period rental
getNewRental (AP.BaseAnnualRate Rate
r) Date
sd Date
ed (ByPeriodRental Amount
rental Period
per) 
  = (Rate -> LeaseAssetRentAssump
AP.BaseAnnualRate Rate
r
    , Amount -> Period -> LeaseRateCalc
ByPeriodRental (Amount -> Rate -> Amount
mulBR Amount
rental (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+ DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
DC_ACT_365F Date
sd Date
ed Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate -> Rate
forall a. Fractional a => Rate -> a
fromRational Rate
r)) Period
per)
getNewRental (AP.BaseCurve Ts
rc) Date
sd Date
ed (ByPeriodRental Amount
rental Period
per) 
  = (Ts -> LeaseAssetRentAssump
AP.BaseCurve Ts
rc
    , Amount -> Period -> LeaseRateCalc
ByPeriodRental (Amount -> Rate -> Amount
mulBR Amount
rental (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+ DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
DC_ACT_365F Date
sd Date
ed Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* (Rate -> Rate
forall a. Fractional a => Rate -> a
fromRational (Ts -> CutoffType -> Date -> Rate
getValByDate Ts
rc CutoffType
Exc Date
ed)))) Period
per)
getNewRental (AP.BaseByVec [Rate]
rs) Date
sd Date
ed (ByPeriodRental Amount
rental Period
per)
  = let
      (Amount
newRental,[Rate]
nextRs) = case [Rate] -> Maybe (Rate, [Rate])
forall a. [a] -> Maybe (a, [a])
Data.List.uncons [Rate]
rs of 
                             Just (Rate
r,[Rate]
_rs) -> (Amount -> Rate -> Amount
mulBR Amount
rental (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+ DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
DC_ACT_365F Date
sd Date
ed Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate -> Rate
forall a. Fractional a => Rate -> a
fromRational Rate
r)
                                              , [Rate]
_rs)
                             Maybe (Rate, [Rate])
Nothing -> (Amount
rental,[Rate
0.0])
    in
      ([Rate] -> LeaseAssetRentAssump
AP.BaseByVec [Rate]
nextRs, Amount -> Period -> LeaseRateCalc
ByPeriodRental Amount
newRental Period
per)

calcEndDate :: Date -> Int -> LeaseRateCalc -> Date 
calcEndDate :: Date -> Int -> LeaseRateCalc -> Date
calcEndDate Date
sd Int
periods (ByDayRate Amount
_ DatePattern
dp) = [Date] -> Date
forall a. HasCallStack => [a] -> a
last ([Date] -> Date) -> [Date] -> Date
forall a b. (a -> b) -> a -> b
$ DatePattern -> CutoffType -> Date -> Int -> [Date]
genSerialDates DatePattern
dp CutoffType
Exc Date
sd Int
periods
calcEndDate Date
sd Int
periods (ByPeriodRental Amount
_ Period
per) = [Date] -> Date
forall a. HasCallStack => [a] -> a
last ([Date] -> Date) -> [Date] -> Date
forall a b. (a -> b) -> a -> b
$ Date -> Period -> Int -> [Date]
genDates Date
sd Period
per Int
periods

calcGapDays :: AP.LeaseAssetGapAssump -> Date -> Int
calcGapDays :: LeaseAssetGapAssump -> Date -> Int
calcGapDays (AP.GapDays Int
days) Date
_ = Int
days
calcGapDays (AP.GapDaysByCurve Ts
ts) Date
d = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Rate -> Double
forall a. Fractional a => Rate -> a
fromRational (Rate -> Double) -> Rate -> Double
forall a b. (a -> b) -> a -> b
$ Ts -> CutoffType -> Date -> Rate
getValByDate Ts
ts CutoffType
Exc Date
d 

-- ^ Generate next lease with new rental / term changes/ day gap
nextLease :: Lease -> (AP.LeaseAssetRentAssump, TermChangeRate, DayGap) -> (Lease, Date ,(AP.LeaseAssetRentAssump, TermChangeRate, DayGap))
nextLease :: Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> (Lease, Date, (LeaseAssetRentAssump, Rate, Int))
nextLease l :: Lease
l@(RegularLease (LeaseInfo Date
sd Int
ot LeaseRateCalc
rental Maybe Obligor
ob) Amount
bal Int
rt Status
_) (LeaseAssetRentAssump
rAssump,Rate
tc,Int
gd) 
  = let
        leaseEndDate :: Date
leaseEndDate = [Date] -> Date
forall a. HasCallStack => [a] -> a
last ([Date] -> Date) -> [Date] -> Date
forall a b. (a -> b) -> a -> b
$ Lease -> Int -> [Date]
forall a. Asset a => a -> Int -> [Date]
getPaymentDates Lease
l Int
0
        nextStartDate :: Date
nextStartDate = Integer -> Date -> Date
T.addDays (Integer -> Integer
forall a. Enum a => a -> a
succ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
gd)) Date
leaseEndDate

        nextOriginTerm :: Int
nextOriginTerm = Rate -> Int
forall b. Integral b => Rate -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rate -> Int) -> Rate -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Rate -> Rate
mulIR Int
ot (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+Rate
tc) 
        nextEndDate :: Date
nextEndDate = Date -> Int -> LeaseRateCalc -> Date
calcEndDate Date
nextStartDate Int
ot LeaseRateCalc
rental
        (LeaseAssetRentAssump
newRassump, LeaseRateCalc
nextRental) = LeaseAssetRentAssump
-> Date
-> Date
-> LeaseRateCalc
-> (LeaseAssetRentAssump, LeaseRateCalc)
getNewRental LeaseAssetRentAssump
rAssump Date
sd Date
nextStartDate LeaseRateCalc
rental
        newBal :: Amount
newBal =  -Amount
1
    in 
      (OriginalInfo -> Amount -> Int -> Status -> Lease
RegularLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
nextStartDate Int
nextOriginTerm LeaseRateCalc
nextRental Maybe Obligor
ob) 
                    Amount
newBal Int
nextOriginTerm Status
Current
      ,Date
nextEndDate
      ,(LeaseAssetRentAssump
newRassump,Rate
tc,Int
gd)
      )

nextLease l :: Lease
l@(StepUpLease (LeaseInfo Date
sd Int
ot LeaseRateCalc
rental Maybe Obligor
ob) LeaseStepUp
lsteupInfo Amount
bal Int
rt Status
_) (LeaseAssetRentAssump
rAssump,Rate
tc,Int
gd) 
  = let 
        leaseEndDate :: Date
leaseEndDate = [Date] -> Date
forall a. HasCallStack => [a] -> a
last ([Date] -> Date) -> [Date] -> Date
forall a b. (a -> b) -> a -> b
$ Lease -> Int -> [Date]
forall a. Asset a => a -> Int -> [Date]
getPaymentDates Lease
l Int
0
        nextStartDate :: Date
nextStartDate = Integer -> Date -> Date
T.addDays (Integer -> Integer
forall a. Enum a => a -> a
succ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
gd)) Date
leaseEndDate -- `debug` ("Gap Day ->"++ show gd)
        nextOriginTerm :: Int
nextOriginTerm = Rate -> Int
forall b. Integral b => Rate -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rate -> Int) -> Rate -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Rate -> Rate
mulIR Int
ot (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+Rate
tc) 
        nextEndDate :: Date
nextEndDate = Date -> Int -> LeaseRateCalc -> Date
calcEndDate Date
nextStartDate Int
ot LeaseRateCalc
rental
        (LeaseAssetRentAssump
newRassump, LeaseRateCalc
nextRental) = LeaseAssetRentAssump
-> Date
-> Date
-> LeaseRateCalc
-> (LeaseAssetRentAssump, LeaseRateCalc)
getNewRental LeaseAssetRentAssump
rAssump Date
sd Date
nextStartDate LeaseRateCalc
rental
        newBal :: Amount
newBal = -Amount
1
    in
      (OriginalInfo -> LeaseStepUp -> Amount -> Int -> Status -> Lease
StepUpLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
nextStartDate Int
nextOriginTerm LeaseRateCalc
nextRental Maybe Obligor
ob) 
                    LeaseStepUp
lsteupInfo Amount
newBal Int
nextOriginTerm Status
Current
      ,Date
nextEndDate
      ,(LeaseAssetRentAssump
newRassump,Rate
tc,Int
gd)
      ) --  `debug` ("leaseEndDate>>"++show leaseEndDate++">>>"++show (succ (toInteger gd)))

-- | create a new lease base on the lease in 1st argument, with new rental/term, a gap days, till the end date
nextLeaseTill :: Lease -> (AP.LeaseAssetRentAssump, TermChangeRate, DayGap) -> Date -> AP.LeaseEndType -> [Lease] -> [Lease]
nextLeaseTill :: Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> Date
-> LeaseEndType
-> [Lease]
-> [Lease]
nextLeaseTill Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg) Date
lastDate (AP.CutByDate Date
ed) [Lease]
accum 
  | Date
lastDate Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
ed = [Lease]
accum 
  | Bool
otherwise = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> Date
-> LeaseEndType
-> [Lease]
-> [Lease]
nextLeaseTill Lease
new_lease (LeaseAssetRentAssump, Rate, Int)
newAssump Date
new_lastDate (Date -> LeaseEndType
AP.CutByDate Date
ed) ([Lease]
accum[Lease] -> [Lease] -> [Lease]
forall a. [a] -> [a] -> [a]
++[Lease
new_lease])
                where 
                 (Lease
new_lease,Date
new_lastDate, (LeaseAssetRentAssump, Rate, Int)
newAssump) = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> (Lease, Date, (LeaseAssetRentAssump, Rate, Int))
nextLease Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg)

nextLeaseTill Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg) Date
lastDate (AP.StopByExtTimes Int
n) [Lease]
accum 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Lease]
accum 
  | Bool
otherwise = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> Date
-> LeaseEndType
-> [Lease]
-> [Lease]
nextLeaseTill Lease
new_lease (LeaseAssetRentAssump, Rate, Int)
newAssump Date
new_lastDate (Int -> LeaseEndType
AP.StopByExtTimes (Int -> Int
forall a. Enum a => a -> a
pred Int
n)) ([Lease]
accum[Lease] -> [Lease] -> [Lease]
forall a. [a] -> [a] -> [a]
++[Lease
new_lease])
                where 
                 (Lease
new_lease,Date
new_lastDate, (LeaseAssetRentAssump, Rate, Int)
newAssump) = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> (Lease, Date, (LeaseAssetRentAssump, Rate, Int))
nextLease Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg) 

nextLeaseTill Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg) Date
lastDate (AP.EarlierOf Date
ed Int
n) [Lease]
accum 
  | Date
lastDate Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
ed = [Lease]
accum 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Lease]
accum
  | Bool
otherwise = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> Date
-> LeaseEndType
-> [Lease]
-> [Lease]
nextLeaseTill Lease
new_lease (LeaseAssetRentAssump, Rate, Int)
newAssump Date
new_lastDate (Date -> Int -> LeaseEndType
AP.EarlierOf Date
ed (Int -> Int
forall a. Enum a => a -> a
pred Int
n)) ([Lease]
accum[Lease] -> [Lease] -> [Lease]
forall a. [a] -> [a] -> [a]
++[Lease
new_lease])
                where 
                 (Lease
new_lease,Date
new_lastDate, (LeaseAssetRentAssump, Rate, Int)
newAssump) = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> (Lease, Date, (LeaseAssetRentAssump, Rate, Int))
nextLease Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg)

nextLeaseTill Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg) Date
lastDate (AP.LaterOf Date
ed Int
n) [Lease]
accum 
  | Date
lastDate Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
ed Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Lease]
accum 
  | Bool
otherwise = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> Date
-> LeaseEndType
-> [Lease]
-> [Lease]
nextLeaseTill Lease
new_lease (LeaseAssetRentAssump, Rate, Int)
newAssump Date
new_lastDate (Date -> Int -> LeaseEndType
AP.LaterOf Date
ed (Int -> Int
forall a. Enum a => a -> a
pred Int
n)) ([Lease]
accum[Lease] -> [Lease] -> [Lease]
forall a. [a] -> [a] -> [a]
++[Lease
new_lease])
                where 
                 (Lease
new_lease,Date
new_lastDate, (LeaseAssetRentAssump, Rate, Int)
newAssump) = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> (Lease, Date, (LeaseAssetRentAssump, Rate, Int))
nextLease Lease
l (LeaseAssetRentAssump
rsc,Rate
tc,Int
mg)

-- ^ calculate the daily rate for a step up lease
calcPmts :: LeaseStepUp -> [Rate] -> Amount -> Either String [Amount] 
calcPmts :: LeaseStepUp -> [Rate] -> Amount -> Either String [Amount]
calcPmts (FlatRate Rate
_r) [Rate]
fs Amount
amt = [Amount] -> Either String [Amount]
forall a b. b -> Either a b
Right ((Amount -> Rate -> Amount) -> Amount -> [Rate] -> [Amount]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Amount -> Rate -> Amount
mulBR Amount
amt (Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate ([Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
fs) Rate
_r))
calcPmts (ByFlatAmount Amount
_amt) [Rate]
fs Amount
amt = [Amount] -> Either String [Amount]
forall a b. b -> Either a b
Right ((Amount -> Amount -> Amount) -> Amount -> [Amount] -> [Amount]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
(+) Amount
amt (Int -> Amount -> [Amount]
forall a. Int -> a -> [a]
replicate ([Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
fs) Amount
_amt))
calcPmts (ByRateCurve [Rate]
rs) [Rate]
fs Amount
amt 
  | [Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
fs = String -> Either String [Amount]
forall a b. a -> Either a b
Left String
"ByRateCurve: the rate curve should be the same length as remain pay dates"
  | Bool
otherwise = [Amount] -> Either String [Amount]
forall a b. b -> Either a b
Right ([Amount] -> Either String [Amount])
-> [Amount] -> Either String [Amount]
forall a b. (a -> b) -> a -> b
$ (Amount -> Rate -> Amount) -> Amount -> [Rate] -> [Amount]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Amount -> Rate -> Amount
mulBR Amount
amt [Rate]
rs
calcPmts (ByAmountCurve [Amount]
amts) [Rate]
fs Amount
amt 
  | [Amount] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Amount]
amts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
fs = String -> Either String [Amount]
forall a b. a -> Either a b
Left String
"ByAmountCurve: the rate curve should be the same length as remain pay dates"
  | Bool
otherwise = [Amount] -> Either String [Amount]
forall a b. b -> Either a b
Right ([Amount] -> Either String [Amount])
-> [Amount] -> Either String [Amount]
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount -> Amount) -> Amount -> [Amount] -> [Amount]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
(+) Amount
amt [Amount]
amts

-- ^ return a lease contract with opening balance and a payment cashflow on each payment date
patchBalance :: Lease -> Either String (Lease,[Amount]) 
patchBalance :: Lease -> Either String (Lease, [Amount])
patchBalance l :: Lease
l@(RegularLease (LeaseInfo Date
sd Int
ot (ByDayRate Amount
dr DatePattern
dp) Maybe Obligor
ob) Amount
bal Int
rt Status
st)
  = let 
      cf_dates :: [Date]
cf_dates = Date
sdDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:Lease -> Int -> [Date]
forall a. Asset a => a -> Int -> [Date]
getPaymentDates Lease
l Int
0
      pmts :: [Amount]
pmts = Int -> [Amount] -> [Amount]
forall a. Int -> [a] -> [a]
lastN Int
rt ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ [ Rate -> Amount
forall a. Fractional a => Rate -> a
fromRational (Amount -> Int -> Rate
mulBInt Amount
dr Int
ds) | Int
ds <- [Date] -> [Int]
getIntervalDays [Date]
cf_dates ]
      new_bal :: Amount
new_bal = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
pmts 
    in
      (Lease, [Amount]) -> Either String (Lease, [Amount])
forall a b. b -> Either a b
Right (OriginalInfo -> Amount -> Int -> Status -> Lease
RegularLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
sd Int
ot (Amount -> DatePattern -> LeaseRateCalc
ByDayRate Amount
dr DatePattern
dp) Maybe Obligor
ob) Amount
new_bal Int
rt Status
st, [Amount]
pmts)

patchBalance l :: Lease
l@(RegularLease (LeaseInfo Date
sd Int
ot (ByPeriodRental Amount
rental Period
per) Maybe Obligor
ob) Amount
bal Int
rt Status
st)
  = let 
      -- cf_dates = lastN (succ rt) $ getPaymentDates l 0
      -- intervals = daysInterval cf_dates
      pmts :: [Amount]
pmts = Int -> [Amount] -> [Amount]
forall a. Int -> [a] -> [a]
lastN Int
rt ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ Int -> Amount -> [Amount]
forall a. Int -> a -> [a]
replicate Int
ot Amount
rental
      new_bal :: Amount
new_bal = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
pmts -- `debug` ("cf_date" ++ show cf_dates)
    in 
      do 
        (Lease, [Amount]) -> Either String (Lease, [Amount])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (OriginalInfo -> Amount -> Int -> Status -> Lease
RegularLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
sd Int
ot (Amount -> Period -> LeaseRateCalc
ByPeriodRental Amount
rental Period
per) Maybe Obligor
ob) Amount
new_bal Int
rt Status
st, [Amount]
pmts) -- `debug` ("daily payments" ++ show pmts)


patchBalance l :: Lease
l@(StepUpLease (LeaseInfo Date
sd Int
ot (ByDayRate Amount
dr DatePattern
p) Maybe Obligor
ob) LeaseStepUp
lsu Amount
bal Int
rt Status
st)
  = let 
      cfDates :: [Date]
cfDates = Date
sdDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:Lease -> Int -> [Date]
forall a. Asset a => a -> Int -> [Date]
getPaymentDates Lease
l Int
0
      intervals :: [Integer]
intervals = [Date] -> [Integer]
daysInterval [Date]
cfDates
      factors :: [Rate]
factors = Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Enum a => a -> a
pred Int
ot) Rate
1.0
    in 
      do 
        [Amount]
dailyRentals <- LeaseStepUp -> [Rate] -> Amount -> Either String [Amount]
calcPmts LeaseStepUp
lsu [Rate]
factors Amount
dr
        let pmts :: [Amount]
pmts = Int -> [Amount] -> [Amount]
forall a. Int -> [a] -> [a]
lastN Int
rt ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ [ Rate -> Amount
forall a. Fractional a => Rate -> a
fromRational (Amount -> Integer -> Rate
mulBInteger Amount
r Integer
d) | (Integer
d,Amount
r) <- [Integer] -> [Amount] -> [(Integer, Amount)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
intervals [Amount]
dailyRentals ] 
        let new_bal :: Amount
new_bal = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
pmts -- `debug` ("cf_date" ++ show cf_dates)
        (Lease, [Amount]) -> Either String (Lease, [Amount])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (OriginalInfo -> LeaseStepUp -> Amount -> Int -> Status -> Lease
StepUpLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
sd Int
ot (Amount -> DatePattern -> LeaseRateCalc
ByDayRate Amount
dr DatePattern
p) Maybe Obligor
ob) LeaseStepUp
lsu Amount
new_bal Int
rt Status
st, [Amount]
pmts) -- `debug` ("daily payments" ++ show pmts)

patchBalance l :: Lease
l@(StepUpLease (LeaseInfo Date
sd Int
ot (ByPeriodRental Amount
rental Period
per) Maybe Obligor
ob) LeaseStepUp
lsu Amount
bal Int
rt Status
st)
  = let 
      factors :: [Rate]
factors = Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Enum a => a -> a
pred Int
ot) Rate
1.0
    in 
      do 
        [Amount]
periodRentals <- LeaseStepUp -> [Rate] -> Amount -> Either String [Amount]
calcPmts LeaseStepUp
lsu [Rate]
factors Amount
rental
        let pmts :: [Amount]
pmts = Int -> [Amount] -> [Amount]
forall a. Int -> [a] -> [a]
lastN Int
rt [Amount]
periodRentals
        let new_bal :: Amount
new_bal = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
pmts
        (Lease, [Amount]) -> Either String (Lease, [Amount])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (OriginalInfo -> LeaseStepUp -> Amount -> Int -> Status -> Lease
StepUpLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
sd Int
ot (Amount -> Period -> LeaseRateCalc
ByPeriodRental Amount
rental Period
per) Maybe Obligor
ob) LeaseStepUp
lsu Amount
new_bal Int
rt Status
st, [Amount]
pmts) -- `debug` ("daily payments" ++ show pmts)


allocDefaultToLeaseFlow :: [Rate] -> (Rate,Balance) -> [CF.TsRow] -> [CF.TsRow] -> [CF.TsRow]
-- allocDefaultToLeaseFlow :: [Decimal] -> (Decimal,Decimal) -> [CF.TsRow] -> [CF.TsRow] -> [CF.TsRow]
allocDefaultToLeaseFlow :: [Rate] -> (Rate, Amount) -> [TsRow] -> [TsRow] -> [TsRow]
allocDefaultToLeaseFlow [Rate]
defaultRates (Rate
begFactor,Amount
begBal) [TsRow]
rs [] = [TsRow] -> [TsRow]
forall a. [a] -> [a]
reverse [TsRow]
rs
allocDefaultToLeaseFlow (Rate
defaultRate:[Rate]
defaultRates) (Rate
begFactor,Amount
begBal) [TsRow]
rs (txn :: TsRow
txn@(CF.LeaseFlow Date
d Amount
b Amount
r Amount
def):[TsRow]
txns)
  = let 
      defaultAmt :: Amount
defaultAmt = Amount -> Rate -> Amount
mulBR Amount
begBal Rate
defaultRate
      nextFactor :: Rate
nextFactor = Rate
begFactor Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
defaultRate)
      newRental :: Amount
newRental = Amount -> Rate -> Amount
mulBR Amount
r Rate
nextFactor
      rentalDiff :: Amount
rentalDiff = Amount
r Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Amount
newRental
      nextBal :: Amount
nextBal = (Amount
begBal Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Amount
rentalDiff Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Amount
newRental) -- TODO: hardcode to fix rounding issue
    in 
      [Rate] -> (Rate, Amount) -> [TsRow] -> [TsRow] -> [TsRow]
allocDefaultToLeaseFlow [Rate]
defaultRates (Rate
nextFactor,Amount
nextBal) ((Date -> Amount -> Amount -> Amount -> TsRow
CF.LeaseFlow Date
d Amount
nextBal Amount
newRental Amount
rentalDiff)TsRow -> [TsRow] -> [TsRow]
forall a. a -> [a] -> [a]
:[TsRow]
rs) [TsRow]
txns

calcDefaultRates :: Rate -> CF.CashFlowFrame -> [Rate]
calcDefaultRates :: Rate -> CashFlowFrame -> [Rate]
calcDefaultRates Rate
r CashFlowFrame
cf
  = let 
      -- cfBegDate:cfDates = CF.getAllDatesCashFlowFrame cf
      ds :: [Date]
ds = CashFlowFrame -> [Date]
CF.getAllDatesCashFlowFrame CashFlowFrame
cf
    in
      Rate -> Int -> Rate
Util.toPeriodRateByInterval Rate
r (Int -> Rate) -> [Int] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date] -> [Int]
getIntervalDays [Date]
ds 

applyDefaults :: Maybe AP.LeaseDefaultType -> (CF.CashFlowFrame,[CF.CashFlowFrame]) -> ([CF.TsRow],[[CF.TsRow]])
applyDefaults :: Maybe LeaseDefaultType
-> (CashFlowFrame, [CashFlowFrame]) -> ([TsRow], [[TsRow]])
applyDefaults Maybe LeaseDefaultType
Nothing (CF.CashFlowFrame BeginStatus
_ [TsRow]
txn1,[CashFlowFrame]
cfs) = ([TsRow]
txn1,Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn (CashFlowFrame -> [TsRow]) -> [CashFlowFrame] -> [[TsRow]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CashFlowFrame]
cfs)
-- applyDefaults (Just (AP.DefaultByContinuation r)) (CF.CashFlowFrame _ txn1,cfs)
--  = (txn1,(view CF.cashflowTxn) <$> cfs)
applyDefaults (Just (AP.DefaultByTermination Rate
r)) (CashFlowFrame
cf1,[CashFlowFrame]
cfs)
 = let 
     cf1Factors :: [Rate]
cf1Factors = Rate -> CashFlowFrame -> [Rate]
calcDefaultRates Rate
r CashFlowFrame
cf1
     [[Rate]]
cfsFactors::[[Rate]] = Rate -> CashFlowFrame -> [Rate]
calcDefaultRates Rate
r (CashFlowFrame -> [Rate]) -> [CashFlowFrame] -> [[Rate]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CashFlowFrame]
cfs 
   in 
      ([Rate] -> (Rate, Amount) -> [TsRow] -> [TsRow] -> [TsRow]
allocDefaultToLeaseFlow [Rate]
cf1Factors (Rate
1.0, (CashFlowFrame -> Amount
CF.getBegBalCashFlowFrame CashFlowFrame
cf1)) [] (Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
cf1) 
        , (\([Rate]
fs,CashFlowFrame
cf) -> [Rate] -> (Rate, Amount) -> [TsRow] -> [TsRow] -> [TsRow]
allocDefaultToLeaseFlow [Rate]
fs (Rate
1.0, (CashFlowFrame -> Amount
CF.getBegBalCashFlowFrame CashFlowFrame
cf)) [] (Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
cf)) (([Rate], CashFlowFrame) -> [TsRow])
-> [([Rate], CashFlowFrame)] -> [[TsRow]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Rate]] -> [CashFlowFrame] -> [([Rate], CashFlowFrame)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Rate]]
cfsFactors [CashFlowFrame]
cfs)
      )

applyDefaults (Just (AP.DefaultByContinuation Rate
r)) (CashFlowFrame
cf1,[CashFlowFrame]
cfs)
  = let 
      cf1Defaults :: [Rate]
cf1Defaults = Rate -> CashFlowFrame -> [Rate]
calcDefaultRates Rate
r CashFlowFrame
cf1
      [[Rate]]
cfsDefaults::[[Rate]] = Rate -> CashFlowFrame -> [Rate]
calcDefaultRates Rate
r (CashFlowFrame -> [Rate]) -> [CashFlowFrame] -> [[Rate]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CashFlowFrame]
cfs

      cf1Factor :: Rate
cf1Factor = (Rate -> Rate -> Rate) -> Rate -> [Rate] -> Rate
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
(*) Rate
1.0 ([Rate] -> Rate) -> [Rate] -> Rate
forall a b. (a -> b) -> a -> b
$ (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-) (Rate -> Rate) -> [Rate] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
cf1Defaults
      cfsFactors :: [Rate]
cfsFactors = (\[Rate]
df -> (Rate -> Rate -> Rate) -> Rate -> [Rate] -> Rate
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
(*) Rate
1.0  ((Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-) (Rate -> Rate) -> [Rate] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
df)) ([Rate] -> Rate) -> [[Rate]] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Rate]]
cfsDefaults

      cfFactors :: [Rate]
cfFactors = Rate
cf1Factor Rate -> [Rate] -> [Rate]
forall a. a -> [a] -> [a]
: ([Rate] -> [Rate]
forall a. HasCallStack => [a] -> [a]
init [Rate]
cfsFactors)

      cfs' :: [CashFlowFrame]
cfs' = (Rate -> CashFlowFrame -> CashFlowFrame)
-> [Rate] -> [CashFlowFrame] -> [CashFlowFrame]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rate -> CashFlowFrame -> CashFlowFrame
CF.splitCf [Rate]
cfsFactors [CashFlowFrame]
cfs -- `debug` ("Cfs"++  show (cfsFactors))
   in 
      ([Rate] -> (Rate, Amount) -> [TsRow] -> [TsRow] -> [TsRow]
allocDefaultToLeaseFlow [Rate]
cf1Defaults (Rate
1.0, (CashFlowFrame -> Amount
CF.getBegBalCashFlowFrame CashFlowFrame
cf1)) [] (Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
cf1)
        , (\([Rate]
fs,CashFlowFrame
cf) -> [Rate] -> (Rate, Amount) -> [TsRow] -> [TsRow] -> [TsRow]
allocDefaultToLeaseFlow [Rate]
fs (Rate
1.0, (CashFlowFrame -> Amount
CF.getBegBalCashFlowFrame CashFlowFrame
cf)) [] (Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
cf)) (([Rate], CashFlowFrame) -> [TsRow])
-> [([Rate], CashFlowFrame)] -> [[TsRow]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Rate]] -> [CashFlowFrame] -> [([Rate], CashFlowFrame)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Rate]]
cfsDefaults [CashFlowFrame]
cfs')
      )


instance Asset Lease where 
    calcCashflow :: Lease
-> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
calcCashflow Lease
l Date
d Maybe [RateAssumption]
_ =
      do 
        (Lease
l',[Amount]
pmts) <- Lease -> Either String (Lease, [Amount])
patchBalance Lease
l
        let bal :: Amount
bal = Lease -> Amount
forall a. Asset a => a -> Amount
getCurrentBal Lease
l' -- `debug` ("payments"++ show pmts)
        let pDates :: [Date]
pDates = Int -> [Date] -> [Date]
forall a. Int -> [a] -> [a]
lastN (Lease -> Int
forall a. Asset a => a -> Int
getRemainTerms Lease
l) ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ Lease -> Int -> [Date]
forall a. Asset a => a -> Int -> [Date]
getPaymentDates Lease
l Int
0 
        let bals :: [Amount]
bals = [Amount] -> [Amount]
forall a. HasCallStack => [a] -> [a]
tail ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount -> Amount) -> Amount -> [Amount] -> [Amount]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) Amount
bal [Amount]
pmts  -- `debug` ("pDates "++ show pDates)
        let defaults :: [Amount]
defaults = Int -> Amount -> [Amount]
forall a. Int -> a -> [a]
replicate ([Date] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Date]
pDates) Amount
0.0 -- `debug` ("bals"++ show bals++ ">> d"++ show d)
        CashFlowFrame -> Either String CashFlowFrame
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (CashFlowFrame -> Either String CashFlowFrame)
-> CashFlowFrame -> Either String CashFlowFrame
forall a b. (a -> b) -> a -> b
$ BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame ([Amount] -> Amount
forall a. HasCallStack => [a] -> a
head [Amount]
bals,Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
d (Lease -> Date
forall a. Asset a => a -> Date
getOriginDate Lease
l), Maybe Amount
forall a. Maybe a
Nothing) ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ CutoffType -> DateDirection -> Date -> [TsRow] -> [TsRow]
forall ts.
TimeSeries ts =>
CutoffType -> DateDirection -> Date -> [ts] -> [ts]
cutBy CutoffType
Inc DateDirection
Future Date
d ((Date -> Amount -> Amount -> Amount -> TsRow)
-> [Date] -> [Amount] -> [Amount] -> [Amount] -> [TsRow]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 Date -> Amount -> Amount -> Amount -> TsRow
CF.LeaseFlow [Date]
pDates [Amount]
bals [Amount]
pmts [Amount]
defaults)

    getOriginInfo :: Lease -> OriginalInfo
getOriginInfo (StepUpLease OriginalInfo
lInfo LeaseStepUp
lsteupInfo Amount
bal Int
rt Status
st) =  OriginalInfo
lInfo
    getOriginInfo (RegularLease OriginalInfo
lInfo Amount
bal Int
rt Status
st) = OriginalInfo
lInfo
      
    getOriginDate :: Lease -> Date
getOriginDate (StepUpLease (LeaseInfo Date
sd Int
_ LeaseRateCalc
_ Maybe Obligor
_) LeaseStepUp
_ Amount
_ Int
_ Status
_) = Date
sd
    getOriginDate (RegularLease (LeaseInfo Date
sd Int
_ LeaseRateCalc
_ Maybe Obligor
_) Amount
_ Int
_ Status
_)  = Date
sd

    getPaymentDates :: Lease -> Int -> [Date]
getPaymentDates Lease
l Int
ot
      = case OriginalInfo -> LeaseRateCalc
originRental (Lease -> OriginalInfo
forall a. Asset a => a -> OriginalInfo
getOriginInfo Lease
l) of
          ByDayRate Amount
_ DatePattern
dp -> DatePattern -> CutoffType -> Date -> Int -> [Date]
genSerialDates DatePattern
dp CutoffType
Exc (Lease -> Date
forall a. Asset a => a -> Date
getOriginDate Lease
l) (Int
ot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Lease -> Int
forall a. Asset a => a -> Int
getTotalTerms Lease
l)
          ByPeriodRental Amount
_ Period
per -> Date -> Period -> Int -> [Date]
genDates (Lease -> Date
forall a. Asset a => a -> Date
getOriginDate Lease
l) Period
per (Int
ot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Lease -> Int
forall a. Asset a => a -> Int
getTotalTerms Lease
l)
    
    getRemainTerms :: Lease -> Int
getRemainTerms (StepUpLease OriginalInfo
_ LeaseStepUp
_ Amount
_ Int
rt Status
_) = Int
rt
    getRemainTerms (RegularLease OriginalInfo
_ Amount
_ Int
rt Status
_)  = Int
rt

    getTotalTerms :: Lease -> Int
getTotalTerms (RegularLease (LeaseInfo Date
_ Int
ot LeaseRateCalc
_ Maybe Obligor
_) Amount
_ Int
_ Status
_) = Int
ot
    getTotalTerms (StepUpLease (LeaseInfo Date
_ Int
ot LeaseRateCalc
_ Maybe Obligor
_) LeaseStepUp
_ Amount
_ Int
_ Status
_) = Int
ot
    
    updateOriginDate :: Lease -> Date -> Lease
updateOriginDate (StepUpLease (LeaseInfo Date
sd Int
ot LeaseRateCalc
rental Maybe Obligor
ob) LeaseStepUp
lsu Amount
bal Int
rt Status
st) Date
nd 
      = OriginalInfo -> LeaseStepUp -> Amount -> Int -> Status -> Lease
StepUpLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
nd Int
ot LeaseRateCalc
rental Maybe Obligor
ob) LeaseStepUp
lsu Amount
bal Int
rt Status
st
    updateOriginDate (RegularLease (LeaseInfo Date
sd Int
ot LeaseRateCalc
rental Maybe Obligor
ob) Amount
bal Int
rt Status
st) Date
nd 
      = OriginalInfo -> Amount -> Int -> Status -> Lease
RegularLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
nd Int
ot LeaseRateCalc
rental Maybe Obligor
ob) Amount
bal Int
rt Status
st
      
    -- resetToOrig (StepUpLease (LeaseInfo sd ot dp dr ob) lsu bal rt st) 
    --   = fst . patchBalance $ StepUpLease (LeaseInfo sd ot dp dr ob) lsu bal ot st
    -- resetToOrig (RegularLease (LeaseInfo sd ot dp dr ob) bal rt st) 
    --   = fst . patchBalance $ RegularLease (LeaseInfo sd ot dp dr ob) bal ot st

    projCashflow :: Lease
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either String (CashFlowFrame, Map CutoffFields Amount)
projCashflow Lease
l Date
asOfDay (AP.LeaseAssump Maybe LeaseDefaultType
mDefault LeaseAssetGapAssump
gapAssump LeaseAssetRentAssump
rentAssump LeaseEndType
endType,AssetDelinqPerfAssumption
_,AssetDefaultedPerfAssumption
_) Maybe [RateAssumption]
mRates
      = let 
          pdates :: [Date]
pdates = Lease -> Int -> [Date]
forall a. Asset a => a -> Int -> [Date]
getPaymentDates Lease
l Int
0  -- `debug` ("8")-- `debug` ("RCURVE"++show rcCurve)
          -- get the gap days between leases
          pickGapDays :: LeaseAssetGapAssump -> Int
pickGapDays (AP.GapDays Int
days) = Int
days
          pickGapDays (AP.GapDaysByCurve Ts
cv) = Ts -> Date -> Int
getIntValOnByDate Ts
cv Date
asOfDay 
        
          newLeases :: [Lease]
newLeases = Lease
-> (LeaseAssetRentAssump, Rate, Int)
-> Date
-> LeaseEndType
-> [Lease]
-> [Lease]
nextLeaseTill 
                        Lease
l
                        (LeaseAssetRentAssump
rentAssump , Rate
0.0 , LeaseAssetGapAssump -> Int
pickGapDays LeaseAssetGapAssump
gapAssump) 
                        ([Date] -> Date
forall a. HasCallStack => [a] -> a
last [Date]
pdates) 
                        LeaseEndType
endType
                        []
          stressRentals :: Integer
stressRentals  = Integer
0
        in
          do
            CashFlowFrame
currentCf <- Lease
-> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
forall a.
Asset a =>
a -> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
calcCashflow Lease
l Date
asOfDay Maybe [RateAssumption]
mRates
            [CashFlowFrame]
newCfs <- [Either String CashFlowFrame] -> Either String [CashFlowFrame]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [ Lease
-> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
forall a.
Asset a =>
a -> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
calcCashflow Lease
l Date
asOfDay Maybe [RateAssumption]
mRates | Lease
l <- [Lease]
newLeases ] --  `debug` ("Current CF\n "++ show currentCf)
            let ([TsRow]
curCf,[[TsRow]]
newTxns) = Maybe LeaseDefaultType
-> (CashFlowFrame, [CashFlowFrame]) -> ([TsRow], [[TsRow]])
applyDefaults Maybe LeaseDefaultType
mDefault (CashFlowFrame
currentCf, [CashFlowFrame]
newCfs)
            -- let allTxns = view CF.cashflowTxn currentCf ++ (concat $ (view CF.cashflowTxn) <$> newCfs)
            let allTxns :: [TsRow]
allTxns = [TsRow]
curCf [TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++ [[TsRow]] -> [TsRow]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TsRow]]
newTxns
            let begBal :: Amount
begBal = [TsRow] -> Amount
CF.buildBegBal [TsRow]
allTxns
            (CashFlowFrame, Map CutoffFields Amount)
-> Either String (CashFlowFrame, Map CutoffFields Amount)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Amount)
 -> Either String (CashFlowFrame, Map CutoffFields Amount))
-> (CashFlowFrame, Map CutoffFields Amount)
-> Either String (CashFlowFrame, Map CutoffFields Amount)
forall a b. (a -> b) -> a -> b
$ (BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Amount
begBal,Date -> Date -> Date
forall a. Ord a => a -> a -> a
max Date
asOfDay (Lease -> Date
forall a. Asset a => a -> Date
getOriginDate Lease
l),Maybe Amount
forall a. Maybe a
Nothing) [TsRow]
allTxns, Map CutoffFields Amount
forall k a. Map k a
Map.empty)  
        

    projCashflow Lease
a Date
b AssetPerf
c Maybe [RateAssumption]
d = String -> Either String (CashFlowFrame, Map CutoffFields Amount)
forall a b. a -> Either a b
Left (String -> Either String (CashFlowFrame, Map CutoffFields Amount))
-> String -> Either String (CashFlowFrame, Map CutoffFields Amount)
forall a b. (a -> b) -> a -> b
$ String
"Failed to match when proj lease with assumption >>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Lease -> String
forall a. Show a => a -> String
show Lease
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ Date -> String
forall a. Show a => a -> String
show Date
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ AssetPerf -> String
forall a. Show a => a -> String
show AssetPerf
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe [RateAssumption] -> String
forall a. Show a => a -> String
show Maybe [RateAssumption]
d
    
    getCurrentBal :: Lease -> Amount
getCurrentBal Lease
l = case Lease
l of 
                        StepUpLease OriginalInfo
_ LeaseStepUp
_ Amount
bal Int
_ Status
_ -> Amount
bal
                        RegularLease OriginalInfo
_ Amount
bal Int
_ Status
_-> Amount
bal

    -- getOriginRate (StepUpLease (LeaseInfo _ _ _ dr _) _ _ _ _) = fromRational $ toRational dr
    -- getOriginRate (RegularLease (LeaseInfo _ _ _ dr _) _ _ _) = fromRational $ toRational dr
    getOriginRate :: Lease -> IRate
getOriginRate Lease
_ = IRate
0.0

    isDefaulted :: Lease -> Bool
isDefaulted (StepUpLease OriginalInfo
_ LeaseStepUp
_ Amount
_ Int
rt Status
Current) = Bool
False
    isDefaulted (RegularLease OriginalInfo
_ Amount
_  Int
rt Status
Current) = Bool
False
    isDefaulted Lease
_ = Bool
True

    getOriginBal :: Lease -> Amount
getOriginBal Lease
l = 
      let 
            _sd :: Date
_sd = case Lease
l of 
                RegularLease (LeaseInfo Date
sd Int
_ LeaseRateCalc
_ Maybe Obligor
_) Amount
bal Int
_ Status
_ -> Date
sd 
                StepUpLease (LeaseInfo Date
sd Int
_ LeaseRateCalc
_ Maybe Obligor
_) LeaseStepUp
_ Amount
bal Int
_ Status
_  -> Date
sd 
      in  
        case Lease
-> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
forall a.
Asset a =>
a -> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
calcCashflow Lease
l Date
_sd Maybe [RateAssumption]
forall a. Maybe a
Nothing of
            Right (CF.CashFlowFrame BeginStatus
_ [TsRow]
txns) -> TsRow -> Amount
CF.mflowBegBalance (TsRow -> Amount) -> TsRow -> Amount
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
txns
            Left String
_ -> Amount
0

    splitWith :: Lease -> [Rate] -> [Lease]
splitWith (RegularLease (LeaseInfo Date
sd Int
ot LeaseRateCalc
dr Maybe Obligor
ob) Amount
bal Int
rt Status
st ) [Rate]
rs
      = [ OriginalInfo -> Amount -> Int -> Status -> Lease
RegularLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
sd Int
ot LeaseRateCalc
dr Maybe Obligor
ob) (Amount -> Rate -> Amount
mulBR Amount
bal Rate
ratio) Int
rt Status
st | Rate
ratio <- [Rate]
rs ] 
    splitWith (StepUpLease (LeaseInfo Date
sd Int
ot LeaseRateCalc
dr Maybe Obligor
ob) LeaseStepUp
stup Amount
bal Int
rt Status
st ) [Rate]
rs
      = [ OriginalInfo -> LeaseStepUp -> Amount -> Int -> Status -> Lease
StepUpLease (Date -> Int -> LeaseRateCalc -> Maybe Obligor -> OriginalInfo
LeaseInfo Date
sd Int
ot LeaseRateCalc
dr Maybe Obligor
ob) LeaseStepUp
stup (Amount -> Rate -> Amount
mulBR Amount
bal Rate
ratio) Int
rt Status
st | Rate
ratio <- [Rate]
rs]