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

module InterestRate
  (ARM(..),RateType(..),runInterestRate2,runInterestRate,UseRate(..)
  ,getRateResetDates,getDayCount,calcInt, calcIntRate,calcIntRateCurve
  ,getSpread,_getSpread)
  
  where

import Language.Haskell.TH
import Data.Aeson       hiding (json)
import Data.Aeson.TH
import Data.Maybe
import Data.Fixed
import GHC.Generics
import DateUtil
import Data.Decimal

import Types
import Util
import Lib

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

type InitPeriod = Int 
type PeriodicCap = Maybe Spread
type LifetimeCap = Maybe IRate
type PaymentCap = Maybe Balance
type RateFloor = Maybe IRate
type RateCap = Maybe IRate
type InitCap = Maybe IRate
type ResetDates = [Date]
type StartRate = IRate

data RateType = Fix DayCount IRate
              | Floater DayCount Index Spread IRate DatePattern RateFloor RateCap (Maybe (RoundingBy IRate))
              deriving (Int -> RateType -> ShowS
[RateType] -> ShowS
RateType -> String
(Int -> RateType -> ShowS)
-> (RateType -> String) -> ([RateType] -> ShowS) -> Show RateType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RateType -> ShowS
showsPrec :: Int -> RateType -> ShowS
$cshow :: RateType -> String
show :: RateType -> String
$cshowList :: [RateType] -> ShowS
showList :: [RateType] -> ShowS
Show,(forall x. RateType -> Rep RateType x)
-> (forall x. Rep RateType x -> RateType) -> Generic RateType
forall x. Rep RateType x -> RateType
forall x. RateType -> Rep RateType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RateType -> Rep RateType x
from :: forall x. RateType -> Rep RateType x
$cto :: forall x. Rep RateType x -> RateType
to :: forall x. Rep RateType x -> RateType
Generic,RateType -> RateType -> Bool
(RateType -> RateType -> Bool)
-> (RateType -> RateType -> Bool) -> Eq RateType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RateType -> RateType -> Bool
== :: RateType -> RateType -> Bool
$c/= :: RateType -> RateType -> Bool
/= :: RateType -> RateType -> Bool
Eq,Eq RateType
Eq RateType =>
(RateType -> RateType -> Ordering)
-> (RateType -> RateType -> Bool)
-> (RateType -> RateType -> Bool)
-> (RateType -> RateType -> Bool)
-> (RateType -> RateType -> Bool)
-> (RateType -> RateType -> RateType)
-> (RateType -> RateType -> RateType)
-> Ord RateType
RateType -> RateType -> Bool
RateType -> RateType -> Ordering
RateType -> RateType -> RateType
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 :: RateType -> RateType -> Ordering
compare :: RateType -> RateType -> Ordering
$c< :: RateType -> RateType -> Bool
< :: RateType -> RateType -> Bool
$c<= :: RateType -> RateType -> Bool
<= :: RateType -> RateType -> Bool
$c> :: RateType -> RateType -> Bool
> :: RateType -> RateType -> Bool
$c>= :: RateType -> RateType -> Bool
>= :: RateType -> RateType -> Bool
$cmax :: RateType -> RateType -> RateType
max :: RateType -> RateType -> RateType
$cmin :: RateType -> RateType -> RateType
min :: RateType -> RateType -> RateType
Ord)

getDayCount :: RateType -> DayCount
getDayCount :: RateType -> DayCount
getDayCount (Fix DayCount
dc IRate
_) = DayCount
dc
getDayCount (Floater DayCount
dc Index
_ IRate
_ IRate
_ DatePattern
_ RateFloor
_ RateFloor
_ Maybe (RoundingBy IRate)
_ ) = DayCount
dc

_getSpread :: RateType -> Maybe Spread
_getSpread :: RateType -> RateFloor
_getSpread (Fix DayCount
_ IRate
_) = RateFloor
forall a. Maybe a
Nothing
_getSpread (Floater DayCount
_ Index
_ IRate
spd IRate
_ DatePattern
_ RateFloor
_ RateFloor
_ Maybe (RoundingBy IRate)
_) = IRate -> RateFloor
forall a. a -> Maybe a
Just IRate
spd

data ARM = ARM InitPeriod InitCap PeriodicCap LifetimeCap RateFloor
         | OtherARM
         deriving (Int -> ARM -> ShowS
[ARM] -> ShowS
ARM -> String
(Int -> ARM -> ShowS)
-> (ARM -> String) -> ([ARM] -> ShowS) -> Show ARM
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ARM -> ShowS
showsPrec :: Int -> ARM -> ShowS
$cshow :: ARM -> String
show :: ARM -> String
$cshowList :: [ARM] -> ShowS
showList :: [ARM] -> ShowS
Show,(forall x. ARM -> Rep ARM x)
-> (forall x. Rep ARM x -> ARM) -> Generic ARM
forall x. Rep ARM x -> ARM
forall x. ARM -> Rep ARM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ARM -> Rep ARM x
from :: forall x. ARM -> Rep ARM x
$cto :: forall x. Rep ARM x -> ARM
to :: forall x. Rep ARM x -> ARM
Generic,ARM -> ARM -> Bool
(ARM -> ARM -> Bool) -> (ARM -> ARM -> Bool) -> Eq ARM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ARM -> ARM -> Bool
== :: ARM -> ARM -> Bool
$c/= :: ARM -> ARM -> Bool
/= :: ARM -> ARM -> Bool
Eq,Eq ARM
Eq ARM =>
(ARM -> ARM -> Ordering)
-> (ARM -> ARM -> Bool)
-> (ARM -> ARM -> Bool)
-> (ARM -> ARM -> Bool)
-> (ARM -> ARM -> Bool)
-> (ARM -> ARM -> ARM)
-> (ARM -> ARM -> ARM)
-> Ord ARM
ARM -> ARM -> Bool
ARM -> ARM -> Ordering
ARM -> ARM -> ARM
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 :: ARM -> ARM -> Ordering
compare :: ARM -> ARM -> Ordering
$c< :: ARM -> ARM -> Bool
< :: ARM -> ARM -> Bool
$c<= :: ARM -> ARM -> Bool
<= :: ARM -> ARM -> Bool
$c> :: ARM -> ARM -> Bool
> :: ARM -> ARM -> Bool
$c>= :: ARM -> ARM -> Bool
>= :: ARM -> ARM -> Bool
$cmax :: ARM -> ARM -> ARM
max :: ARM -> ARM -> ARM
$cmin :: ARM -> ARM -> ARM
min :: ARM -> ARM -> ARM
Ord)

getRateResetDates :: Date -> Date -> Maybe RateType -> Dates
getRateResetDates :: Date -> Date -> Maybe RateType -> Dates
getRateResetDates Date
_ Date
_ Maybe RateType
Nothing = []
getRateResetDates Date
_ Date
_ (Just (Fix DayCount
_ IRate
_)) = []
getRateResetDates Date
sd Date
ed (Just (Floater DayCount
_ Index
_ IRate
_ IRate
_ DatePattern
dp RateFloor
_ RateFloor
_ Maybe (RoundingBy IRate)
_)) = RangeType -> Date -> DatePattern -> Date -> Dates
genSerialDatesTill2 RangeType
NO_IE Date
sd DatePattern
dp Date
ed 

runInterestRate :: ARM -> StartRate -> RateType -> ResetDates -> Ts -> [IRate]
runInterestRate :: ARM -> IRate -> RateType -> Dates -> Ts -> [IRate]
runInterestRate (ARM Int
ip RateFloor
icap RateFloor
pc RateFloor
lifeCap RateFloor
floor) IRate
sr (Floater DayCount
_ Index
_ IRate
spd IRate
_ DatePattern
_ RateFloor
_ RateFloor
_ Maybe (RoundingBy IRate)
mRoundBy) Dates
resetDates Ts
rc
  = IRate
srIRate -> [IRate] -> [IRate]
forall a. a -> [a] -> [a]
:[IRate]
cappedRates
    where 
      IRate
fr:[IRate]
rrs = (IRate
spd IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+) (IRate -> IRate) -> (Rate -> IRate) -> Rate -> IRate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational (Rate -> IRate) -> [Rate] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ts -> CutoffType -> Dates -> [Rate]
getValByDates Ts
rc CutoffType
Inc Dates
resetDates
      firstRate :: IRate
firstRate 
        | RateFloor -> Bool
forall a. Maybe a -> Bool
isNothing RateFloor
icap = IRate
fr
        | (IRate
sr IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ IRate -> RateFloor -> IRate
forall a. a -> Maybe a -> a
fromMaybe IRate
0 RateFloor
icap) IRate -> IRate -> Bool
forall a. Ord a => a -> a -> Bool
<= IRate
fr = IRate
sr IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ IRate -> RateFloor -> IRate
forall a. a -> Maybe a -> a
fromMaybe IRate
0 RateFloor
icap
        | Bool
otherwise = IRate
fr
      rounder :: IRate -> IRate
rounder = Maybe (RoundingBy IRate) -> IRate -> IRate
forall a.
(Fractional a, RealFrac a) =>
Maybe (RoundingBy a) -> a -> a
roundingByM Maybe (RoundingBy IRate)
mRoundBy
      restRates :: [IRate]
restRates = [IRate] -> [IRate]
forall a. HasCallStack => [a] -> [a]
tail ([IRate] -> [IRate]) -> [IRate] -> [IRate]
forall a b. (a -> b) -> a -> b
$
                    (IRate -> IRate -> IRate) -> IRate -> [IRate] -> [IRate]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl 
                      (\IRate
lastRate IRate
idxRate -> 
                          if RateFloor -> Bool
forall a. Maybe a -> Bool
isNothing RateFloor
pc then -- periodic cap
                            IRate -> IRate
rounder IRate
idxRate
                          else
                            if IRate
lastRate IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ (IRate -> RateFloor -> IRate
forall a. a -> Maybe a -> a
fromMaybe IRate
0 RateFloor
pc) IRate -> IRate -> Bool
forall a. Ord a => a -> a -> Bool
<= IRate
idxRate then 
                              IRate -> IRate
rounder (IRate -> IRate) -> IRate -> IRate
forall a b. (a -> b) -> a -> b
$ IRate
lastRate IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+ (IRate -> RateFloor -> IRate
forall a. a -> Maybe a -> a
fromMaybe IRate
0 RateFloor
pc)
                            else 
                              IRate -> IRate
rounder IRate
idxRate)
                      IRate
firstRate
                      [IRate]
rrs
      flooredRates :: [IRate]
flooredRates = IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
max (IRate -> RateFloor -> IRate
forall a. a -> Maybe a -> a
fromMaybe IRate
0 RateFloor
floor) (IRate -> IRate) -> [IRate] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IRate
firstRateIRate -> [IRate] -> [IRate]
forall a. a -> [a] -> [a]
:[IRate]
restRates) -- `debug` ("reset rates" ++ show (firstRate:restRates))
      cappedRates :: [IRate]
cappedRates = IRate -> IRate -> IRate
forall a. Ord a => a -> a -> a
min (IRate -> RateFloor -> IRate
forall a. a -> Maybe a -> a
fromMaybe IRate
1 RateFloor
lifeCap) (IRate -> IRate) -> [IRate] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate]
flooredRates 

runInterestRate2 :: ARM -> (Date,StartRate) -> RateType -> ResetDates -> Ts -> Ts
runInterestRate2 :: ARM -> (Date, IRate) -> RateType -> Dates -> Ts -> Ts
runInterestRate2 ARM
arm (Date
d,IRate
sr) RateType
floater Dates
resetDates Ts
rc
  = [(Date, IRate)] -> Ts
mkRateTs ([(Date, IRate)] -> Ts) -> [(Date, IRate)] -> Ts
forall a b. (a -> b) -> a -> b
$ Dates -> [IRate] -> [(Date, IRate)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Date
dDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
resetDates) [IRate]
resultRates -- `debug` ("Result Rate"++show resultRates)
    where 
     resultRates :: [IRate]
resultRates = ARM -> IRate -> RateType -> Dates -> Ts -> [IRate]
runInterestRate ARM
arm IRate
sr RateType
floater Dates
resetDates Ts
rc 
     
calcIntRate :: Date -> Date -> IRate -> DayCount -> IRate
calcIntRate :: Date -> Date -> IRate -> DayCount -> IRate
calcIntRate Date
startDate Date
endDate IRate
intRate DayCount
dayCount =
  let 
    yf :: Rate
yf = DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
dayCount Date
startDate Date
endDate
  in 
    IRate
intRate IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
* Rate -> IRate
forall a. Fractional a => Rate -> a
fromRational Rate
yf

calcIntRateCurve :: DayCount -> IRate -> [Date] -> [IRate]
calcIntRateCurve :: DayCount -> IRate -> Dates -> [IRate]
calcIntRateCurve DayCount
dc IRate
r Dates
ds 
  = [ Date -> Date -> IRate -> DayCount -> IRate
calcIntRate Date
sd Date
ed IRate
r DayCount
dc |  (Date
sd,Date
ed) <- Dates -> Dates -> [(Date, Date)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Dates -> Dates
forall a. HasCallStack => [a] -> [a]
init Dates
ds) (Dates -> Dates
forall a. HasCallStack => [a] -> [a]
tail Dates
ds) ]

calcInt :: Balance -> Date -> Date -> IRate -> DayCount -> Amount
calcInt :: Balance -> Date -> Date -> IRate -> DayCount -> Balance
calcInt Balance
bal Date
startDate Date
endDate IRate
intRate DayCount
dayCount =
  let 
    yfactor :: Rate
yfactor = DayCount -> Date -> Date -> Rate
yearCountFraction DayCount
dayCount Date
startDate Date
endDate
  in 
    Balance -> Rate -> Balance
mulBR Balance
bal (Rate
yfactor Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* IRate -> Rate
forall a. Real a => a -> Rate
toRational IRate
intRate)

class UseRate x where 
  isAdjustbleRate :: x -> Bool
  -- get first index available,if not found return Nothing
  getIndex :: x -> Maybe Index
  getIndexes :: x -> Maybe [Index]
  getResetDates :: x -> Dates
  getSpread :: x -> Maybe Spread


$(deriveJSON defaultOptions ''ARM)
$(deriveJSON defaultOptions ''RateType)