{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE BangPatterns #-}

module AssetClass.AssetBase 
  (Installment(..),Lease(..),OriginalInfo(..),Status(..)
  ,LeaseStepUp(..),AccrualPeriod(..),PrepayPenaltyType(..)
  ,AmortPlan(..),Loan(..),Mortgage(..),AssetUnion(..),MixedAsset(..),FixedAsset(..)
  ,AmortRule(..),Capacity(..),AssociateExp(..),AssociateIncome(..),ReceivableFeeType(..),Receivable(..)
  ,ProjectedCashflow(..),Obligor(..),LeaseRateCalc(..)
  ,calcAssetPrinInt, calcPmt
  )
  where

import Language.Haskell.TH
import GHC.Generics
import Data.Aeson.TH
import Data.Aeson.Types
--import Asset

import Data.OpenApi hiding (Server,contentType)

import Types hiding (Current,startDate,originTerm)
import Data.Ratio
import Data.Proxy
import Data.Decimal
import Util
import qualified Data.Map as Map
import qualified InterestRate as IR
import qualified Cashflow as CF
-- import Assumptions (RevolvingAssumption(Dummy4))
import Control.Lens hiding (element,Index)
import Control.Lens.TH

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


type DailyRate = Balance

data AmortPlan = Level                    -- ^ for mortgage / french system  -> fixed payment each period which consist of increasing princial and decreasing interest.
                | Even                    -- ^ for linear mortgage   -> evenly distributed principal repayment
                | I_P                     -- ^ interest only and principal due at last payment
                | F_P                     -- ^ fee based 
                | PO_FirstN Int       -- ^ 0 fee for first N period
                | IO_FirstN Int AmortPlan -- ^ interest only for first N period
                | NO_FirstN Int AmortPlan -- ^ non payment during first N period
                | ScheduleRepayment Ts (Maybe DatePattern)   -- ^ custom principal follow
                | Balloon Int             -- ^ balloon payment with period N
                deriving (Int -> AmortPlan -> ShowS
[AmortPlan] -> ShowS
AmortPlan -> [Char]
(Int -> AmortPlan -> ShowS)
-> (AmortPlan -> [Char])
-> ([AmortPlan] -> ShowS)
-> Show AmortPlan
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmortPlan -> ShowS
showsPrec :: Int -> AmortPlan -> ShowS
$cshow :: AmortPlan -> [Char]
show :: AmortPlan -> [Char]
$cshowList :: [AmortPlan] -> ShowS
showList :: [AmortPlan] -> ShowS
Show, (forall x. AmortPlan -> Rep AmortPlan x)
-> (forall x. Rep AmortPlan x -> AmortPlan) -> Generic AmortPlan
forall x. Rep AmortPlan x -> AmortPlan
forall x. AmortPlan -> Rep AmortPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AmortPlan -> Rep AmortPlan x
from :: forall x. AmortPlan -> Rep AmortPlan x
$cto :: forall x. Rep AmortPlan x -> AmortPlan
to :: forall x. Rep AmortPlan x -> AmortPlan
Generic, Eq AmortPlan
Eq AmortPlan =>
(AmortPlan -> AmortPlan -> Ordering)
-> (AmortPlan -> AmortPlan -> Bool)
-> (AmortPlan -> AmortPlan -> Bool)
-> (AmortPlan -> AmortPlan -> Bool)
-> (AmortPlan -> AmortPlan -> Bool)
-> (AmortPlan -> AmortPlan -> AmortPlan)
-> (AmortPlan -> AmortPlan -> AmortPlan)
-> Ord AmortPlan
AmortPlan -> AmortPlan -> Bool
AmortPlan -> AmortPlan -> Ordering
AmortPlan -> AmortPlan -> AmortPlan
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 :: AmortPlan -> AmortPlan -> Ordering
compare :: AmortPlan -> AmortPlan -> Ordering
$c< :: AmortPlan -> AmortPlan -> Bool
< :: AmortPlan -> AmortPlan -> Bool
$c<= :: AmortPlan -> AmortPlan -> Bool
<= :: AmortPlan -> AmortPlan -> Bool
$c> :: AmortPlan -> AmortPlan -> Bool
> :: AmortPlan -> AmortPlan -> Bool
$c>= :: AmortPlan -> AmortPlan -> Bool
>= :: AmortPlan -> AmortPlan -> Bool
$cmax :: AmortPlan -> AmortPlan -> AmortPlan
max :: AmortPlan -> AmortPlan -> AmortPlan
$cmin :: AmortPlan -> AmortPlan -> AmortPlan
min :: AmortPlan -> AmortPlan -> AmortPlan
Ord, AmortPlan -> AmortPlan -> Bool
(AmortPlan -> AmortPlan -> Bool)
-> (AmortPlan -> AmortPlan -> Bool) -> Eq AmortPlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmortPlan -> AmortPlan -> Bool
== :: AmortPlan -> AmortPlan -> Bool
$c/= :: AmortPlan -> AmortPlan -> Bool
/= :: AmortPlan -> AmortPlan -> Bool
Eq)

-- | calculate period payment (Annuity/Level mortgage)
calcPmt :: Balance -> IRate -> Int -> Amount
calcPmt :: Balance -> IRate -> Int -> Balance
calcPmt Balance
bal IRate
rate Int
periods | IRate
rate IRate -> IRate -> Bool
forall a. Eq a => a -> a -> Bool
== IRate
0.0 = Balance -> Int -> Balance
divideBI Balance
bal Int
periods
                         | Bool
otherwise = 
  let rate' :: Double
rate' = IRate -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac IRate
rate :: Double
      logBase :: Double
logBase = Double -> Double
forall a. Floating a => a -> a
log (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rate')
      num :: Double
num = Double -> Double
forall a. Floating a => a -> a
exp (Double
logBase Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
periods)
      den :: Double
den = Double
num Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
      r1 :: Double
r1 = Double
num Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
den
  in Balance -> Rate -> Balance
mulBR (Balance -> Balance
forall a b. (Real a, Fractional b) => a -> b
realToFrac Balance
bal) (Double -> Rate
forall a. Real a => a -> Rate
toRational (Double
rate' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r1))

type InterestAmount = Balance
type PrincipalAmount = Balance

calcAssetPrinInt :: AmortPlan -> Balance -> IRate -> Int -> Int -> (Balance,Int) -> (InterestAmount, PrincipalAmount)
calcAssetPrinInt :: AmortPlan
-> Balance
-> IRate
-> Int
-> Int
-> (Balance, Int)
-> (Balance, Balance)
calcAssetPrinInt AmortPlan
pt Balance
bal IRate
rate Int
ot Int
rt (Balance
amortBal, Int
amortTerm) = 
  let 
    interestAccrued :: Balance
interestAccrued = Balance -> IRate -> Balance
mulBIR Balance
bal IRate
rate
    pmt :: Balance
pmt = Balance -> IRate -> Int -> Balance
calcPmt Balance
bal IRate
rate Int
rt
    periodPassed :: Int
periodPassed = Int
ot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rt
  in 
    case AmortPlan
pt of 
      AmortPlan
Level -> (Balance
interestAccrued, Balance
pmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
interestAccrued)
      AmortPlan
Even -> (Balance
interestAccrued, Balance
bal Balance -> Balance -> Balance
forall a. Fractional a => a -> a -> a
/ Int -> Balance
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rt)
      AmortPlan
I_P -> if Int
rt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then
               (Balance
interestAccrued, Balance
bal)
             else
               (Balance
interestAccrued, Balance
0)
      NO_FirstN Int
n AmortPlan
_pt -> if Int
periodPassed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n then 
                          AmortPlan
-> Balance
-> IRate
-> Int
-> Int
-> (Balance, Int)
-> (Balance, Balance)
calcAssetPrinInt AmortPlan
_pt Balance
bal IRate
rate Int
ot Int
rt (Balance
amortBal, Int
amortTerm)
                         else
                          (Balance
0, Balance -> Balance
forall a. Num a => a -> a
negate Balance
interestAccrued)
      IO_FirstN Int
n AmortPlan
_pt -> if Int
periodPassed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n then 
                          AmortPlan
-> Balance
-> IRate
-> Int
-> Int
-> (Balance, Int)
-> (Balance, Balance)
calcAssetPrinInt AmortPlan
_pt Balance
bal IRate
rate Int
ot Int
rt (Balance
amortBal, Int
amortTerm)
                         else
                          (Balance
interestAccrued, Balance
0)
      
      Balloon Int
n -> if Int
rt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then
                     (Balance
interestAccrued, Balance
bal)
                   else
                     let 
                       bPmt :: Balance
bPmt = Balance -> IRate -> Int -> Balance
calcPmt Balance
bal IRate
rate (Int
amortTerm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
periodPassed)  -- `debug` ("Amort term"++show (amortTerm - periodPassed) <> " rt"++show periodPassed)
                     in 
                       (Balance
interestAccrued, Balance
bPmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
interestAccrued) -- `debug` ("bal"++show bal++"rate"++show rate++"ot"++show ot++"rt"++show rt++"bPmt"++show bPmt++ "interest"++show interestAccrued)    
                         
      AmortPlan
_ -> [Char] -> (Balance, Balance)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Balance, Balance)) -> [Char] -> (Balance, Balance)
forall a b. (a -> b) -> a -> b
$ [Char]
"unsupported pt "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ AmortPlan -> [Char]
forall a. Show a => a -> [Char]
show AmortPlan
pt


data Status = Current
            | Defaulted (Maybe Date)
            -- | Delinquency (Maybe Int)
            -- | Extended (Maybe T.Day)
            deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> [Char]
(Int -> Status -> ShowS)
-> (Status -> [Char]) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> [Char]
show :: Status -> [Char]
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show,(forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic,Eq Status
Eq Status =>
(Status -> Status -> Ordering)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Status)
-> (Status -> Status -> Status)
-> Ord Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
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 :: Status -> Status -> Ordering
compare :: Status -> Status -> Ordering
$c< :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
>= :: Status -> Status -> Bool
$cmax :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
min :: Status -> Status -> Status
Ord,Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq)

data PrepayPenaltyType = ByTerm Int Rate Rate           -- ^ using penalty rate 1 if period < Int, use penalty rate 2 if period > Int
                       | FixAmount Balance (Maybe Int)  -- ^ fixed penalty fee if any prepayment, or it only applies if period < Int
                       | FixPct Rate (Maybe Int)        -- ^ fixed percentage penalty fee as percentage of prepayment, or it only applies if period < Int
                       | Sliding Rate Rate              -- ^ starting with Rate1 at period 1 then decrease by step by rate2
                       | StepDown [(Int,Rate)]          -- ^ first tuple (n,r) ,first n periods use penalty rate r , then next n periods use pentaly rate in next tuple
                       -- | NMonthInterest Int
                       deriving (Int -> PrepayPenaltyType -> ShowS
[PrepayPenaltyType] -> ShowS
PrepayPenaltyType -> [Char]
(Int -> PrepayPenaltyType -> ShowS)
-> (PrepayPenaltyType -> [Char])
-> ([PrepayPenaltyType] -> ShowS)
-> Show PrepayPenaltyType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrepayPenaltyType -> ShowS
showsPrec :: Int -> PrepayPenaltyType -> ShowS
$cshow :: PrepayPenaltyType -> [Char]
show :: PrepayPenaltyType -> [Char]
$cshowList :: [PrepayPenaltyType] -> ShowS
showList :: [PrepayPenaltyType] -> ShowS
Show,(forall x. PrepayPenaltyType -> Rep PrepayPenaltyType x)
-> (forall x. Rep PrepayPenaltyType x -> PrepayPenaltyType)
-> Generic PrepayPenaltyType
forall x. Rep PrepayPenaltyType x -> PrepayPenaltyType
forall x. PrepayPenaltyType -> Rep PrepayPenaltyType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrepayPenaltyType -> Rep PrepayPenaltyType x
from :: forall x. PrepayPenaltyType -> Rep PrepayPenaltyType x
$cto :: forall x. Rep PrepayPenaltyType x -> PrepayPenaltyType
to :: forall x. Rep PrepayPenaltyType x -> PrepayPenaltyType
Generic,PrepayPenaltyType -> PrepayPenaltyType -> Bool
(PrepayPenaltyType -> PrepayPenaltyType -> Bool)
-> (PrepayPenaltyType -> PrepayPenaltyType -> Bool)
-> Eq PrepayPenaltyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
== :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
$c/= :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
/= :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
Eq,Eq PrepayPenaltyType
Eq PrepayPenaltyType =>
(PrepayPenaltyType -> PrepayPenaltyType -> Ordering)
-> (PrepayPenaltyType -> PrepayPenaltyType -> Bool)
-> (PrepayPenaltyType -> PrepayPenaltyType -> Bool)
-> (PrepayPenaltyType -> PrepayPenaltyType -> Bool)
-> (PrepayPenaltyType -> PrepayPenaltyType -> Bool)
-> (PrepayPenaltyType -> PrepayPenaltyType -> PrepayPenaltyType)
-> (PrepayPenaltyType -> PrepayPenaltyType -> PrepayPenaltyType)
-> Ord PrepayPenaltyType
PrepayPenaltyType -> PrepayPenaltyType -> Bool
PrepayPenaltyType -> PrepayPenaltyType -> Ordering
PrepayPenaltyType -> PrepayPenaltyType -> PrepayPenaltyType
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 :: PrepayPenaltyType -> PrepayPenaltyType -> Ordering
compare :: PrepayPenaltyType -> PrepayPenaltyType -> Ordering
$c< :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
< :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
$c<= :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
<= :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
$c> :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
> :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
$c>= :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
>= :: PrepayPenaltyType -> PrepayPenaltyType -> Bool
$cmax :: PrepayPenaltyType -> PrepayPenaltyType -> PrepayPenaltyType
max :: PrepayPenaltyType -> PrepayPenaltyType -> PrepayPenaltyType
$cmin :: PrepayPenaltyType -> PrepayPenaltyType -> PrepayPenaltyType
min :: PrepayPenaltyType -> PrepayPenaltyType -> PrepayPenaltyType
Ord)

data AmortRule = DecliningBalance        -- ^ DecliningBalance Method
               | StraightLine            -- ^ Straight Line Method
               deriving (Int -> AmortRule -> ShowS
[AmortRule] -> ShowS
AmortRule -> [Char]
(Int -> AmortRule -> ShowS)
-> (AmortRule -> [Char])
-> ([AmortRule] -> ShowS)
-> Show AmortRule
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmortRule -> ShowS
showsPrec :: Int -> AmortRule -> ShowS
$cshow :: AmortRule -> [Char]
show :: AmortRule -> [Char]
$cshowList :: [AmortRule] -> ShowS
showList :: [AmortRule] -> ShowS
Show,(forall x. AmortRule -> Rep AmortRule x)
-> (forall x. Rep AmortRule x -> AmortRule) -> Generic AmortRule
forall x. Rep AmortRule x -> AmortRule
forall x. AmortRule -> Rep AmortRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AmortRule -> Rep AmortRule x
from :: forall x. AmortRule -> Rep AmortRule x
$cto :: forall x. Rep AmortRule x -> AmortRule
to :: forall x. Rep AmortRule x -> AmortRule
Generic,AmortRule -> AmortRule -> Bool
(AmortRule -> AmortRule -> Bool)
-> (AmortRule -> AmortRule -> Bool) -> Eq AmortRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmortRule -> AmortRule -> Bool
== :: AmortRule -> AmortRule -> Bool
$c/= :: AmortRule -> AmortRule -> Bool
/= :: AmortRule -> AmortRule -> Bool
Eq,Eq AmortRule
Eq AmortRule =>
(AmortRule -> AmortRule -> Ordering)
-> (AmortRule -> AmortRule -> Bool)
-> (AmortRule -> AmortRule -> Bool)
-> (AmortRule -> AmortRule -> Bool)
-> (AmortRule -> AmortRule -> Bool)
-> (AmortRule -> AmortRule -> AmortRule)
-> (AmortRule -> AmortRule -> AmortRule)
-> Ord AmortRule
AmortRule -> AmortRule -> Bool
AmortRule -> AmortRule -> Ordering
AmortRule -> AmortRule -> AmortRule
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 :: AmortRule -> AmortRule -> Ordering
compare :: AmortRule -> AmortRule -> Ordering
$c< :: AmortRule -> AmortRule -> Bool
< :: AmortRule -> AmortRule -> Bool
$c<= :: AmortRule -> AmortRule -> Bool
<= :: AmortRule -> AmortRule -> Bool
$c> :: AmortRule -> AmortRule -> Bool
> :: AmortRule -> AmortRule -> Bool
$c>= :: AmortRule -> AmortRule -> Bool
>= :: AmortRule -> AmortRule -> Bool
$cmax :: AmortRule -> AmortRule -> AmortRule
max :: AmortRule -> AmortRule -> AmortRule
$cmin :: AmortRule -> AmortRule -> AmortRule
min :: AmortRule -> AmortRule -> AmortRule
Ord)

data ReceivableFeeType = FixedFee Balance                    -- ^ a flat fee amount
                       | FixedRateFee Rate                   -- ^ a percentage fee against balance for once
                       | FactorFee Rate Int Direction        -- ^ a percentage fee against balance for each period (N days)
                       | AdvanceFee Rate                     -- ^ annualized rate for discount fee based on advance amount
                       | CompoundFee [ReceivableFeeType]     -- ^ compound fee
                       deriving (Int -> ReceivableFeeType -> ShowS
[ReceivableFeeType] -> ShowS
ReceivableFeeType -> [Char]
(Int -> ReceivableFeeType -> ShowS)
-> (ReceivableFeeType -> [Char])
-> ([ReceivableFeeType] -> ShowS)
-> Show ReceivableFeeType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReceivableFeeType -> ShowS
showsPrec :: Int -> ReceivableFeeType -> ShowS
$cshow :: ReceivableFeeType -> [Char]
show :: ReceivableFeeType -> [Char]
$cshowList :: [ReceivableFeeType] -> ShowS
showList :: [ReceivableFeeType] -> ShowS
Show,(forall x. ReceivableFeeType -> Rep ReceivableFeeType x)
-> (forall x. Rep ReceivableFeeType x -> ReceivableFeeType)
-> Generic ReceivableFeeType
forall x. Rep ReceivableFeeType x -> ReceivableFeeType
forall x. ReceivableFeeType -> Rep ReceivableFeeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReceivableFeeType -> Rep ReceivableFeeType x
from :: forall x. ReceivableFeeType -> Rep ReceivableFeeType x
$cto :: forall x. Rep ReceivableFeeType x -> ReceivableFeeType
to :: forall x. Rep ReceivableFeeType x -> ReceivableFeeType
Generic,ReceivableFeeType -> ReceivableFeeType -> Bool
(ReceivableFeeType -> ReceivableFeeType -> Bool)
-> (ReceivableFeeType -> ReceivableFeeType -> Bool)
-> Eq ReceivableFeeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReceivableFeeType -> ReceivableFeeType -> Bool
== :: ReceivableFeeType -> ReceivableFeeType -> Bool
$c/= :: ReceivableFeeType -> ReceivableFeeType -> Bool
/= :: ReceivableFeeType -> ReceivableFeeType -> Bool
Eq,Eq ReceivableFeeType
Eq ReceivableFeeType =>
(ReceivableFeeType -> ReceivableFeeType -> Ordering)
-> (ReceivableFeeType -> ReceivableFeeType -> Bool)
-> (ReceivableFeeType -> ReceivableFeeType -> Bool)
-> (ReceivableFeeType -> ReceivableFeeType -> Bool)
-> (ReceivableFeeType -> ReceivableFeeType -> Bool)
-> (ReceivableFeeType -> ReceivableFeeType -> ReceivableFeeType)
-> (ReceivableFeeType -> ReceivableFeeType -> ReceivableFeeType)
-> Ord ReceivableFeeType
ReceivableFeeType -> ReceivableFeeType -> Bool
ReceivableFeeType -> ReceivableFeeType -> Ordering
ReceivableFeeType -> ReceivableFeeType -> ReceivableFeeType
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 :: ReceivableFeeType -> ReceivableFeeType -> Ordering
compare :: ReceivableFeeType -> ReceivableFeeType -> Ordering
$c< :: ReceivableFeeType -> ReceivableFeeType -> Bool
< :: ReceivableFeeType -> ReceivableFeeType -> Bool
$c<= :: ReceivableFeeType -> ReceivableFeeType -> Bool
<= :: ReceivableFeeType -> ReceivableFeeType -> Bool
$c> :: ReceivableFeeType -> ReceivableFeeType -> Bool
> :: ReceivableFeeType -> ReceivableFeeType -> Bool
$c>= :: ReceivableFeeType -> ReceivableFeeType -> Bool
>= :: ReceivableFeeType -> ReceivableFeeType -> Bool
$cmax :: ReceivableFeeType -> ReceivableFeeType -> ReceivableFeeType
max :: ReceivableFeeType -> ReceivableFeeType -> ReceivableFeeType
$cmin :: ReceivableFeeType -> ReceivableFeeType -> ReceivableFeeType
min :: ReceivableFeeType -> ReceivableFeeType -> ReceivableFeeType
Ord)


data Obligor = Obligor {Obligor -> [Char]
obligorId :: String
                        , Obligor -> [[Char]]
obligorTag :: [String]
                        , Obligor -> Map [Char] (Either [Char] Double)
obligorFields :: Map.Map String (Either String Double)
                        } deriving (Int -> Obligor -> ShowS
[Obligor] -> ShowS
Obligor -> [Char]
(Int -> Obligor -> ShowS)
-> (Obligor -> [Char]) -> ([Obligor] -> ShowS) -> Show Obligor
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Obligor -> ShowS
showsPrec :: Int -> Obligor -> ShowS
$cshow :: Obligor -> [Char]
show :: Obligor -> [Char]
$cshowList :: [Obligor] -> ShowS
showList :: [Obligor] -> ShowS
Show,(forall x. Obligor -> Rep Obligor x)
-> (forall x. Rep Obligor x -> Obligor) -> Generic Obligor
forall x. Rep Obligor x -> Obligor
forall x. Obligor -> Rep Obligor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Obligor -> Rep Obligor x
from :: forall x. Obligor -> Rep Obligor x
$cto :: forall x. Rep Obligor x -> Obligor
to :: forall x. Rep Obligor x -> Obligor
Generic,Obligor -> Obligor -> Bool
(Obligor -> Obligor -> Bool)
-> (Obligor -> Obligor -> Bool) -> Eq Obligor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Obligor -> Obligor -> Bool
== :: Obligor -> Obligor -> Bool
$c/= :: Obligor -> Obligor -> Bool
/= :: Obligor -> Obligor -> Bool
Eq,Eq Obligor
Eq Obligor =>
(Obligor -> Obligor -> Ordering)
-> (Obligor -> Obligor -> Bool)
-> (Obligor -> Obligor -> Bool)
-> (Obligor -> Obligor -> Bool)
-> (Obligor -> Obligor -> Bool)
-> (Obligor -> Obligor -> Obligor)
-> (Obligor -> Obligor -> Obligor)
-> Ord Obligor
Obligor -> Obligor -> Bool
Obligor -> Obligor -> Ordering
Obligor -> Obligor -> Obligor
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 :: Obligor -> Obligor -> Ordering
compare :: Obligor -> Obligor -> Ordering
$c< :: Obligor -> Obligor -> Bool
< :: Obligor -> Obligor -> Bool
$c<= :: Obligor -> Obligor -> Bool
<= :: Obligor -> Obligor -> Bool
$c> :: Obligor -> Obligor -> Bool
> :: Obligor -> Obligor -> Bool
$c>= :: Obligor -> Obligor -> Bool
>= :: Obligor -> Obligor -> Bool
$cmax :: Obligor -> Obligor -> Obligor
max :: Obligor -> Obligor -> Obligor
$cmin :: Obligor -> Obligor -> Obligor
min :: Obligor -> Obligor -> Obligor
Ord)

data LeaseRateCalc = ByDayRate DailyRate DatePattern
                   | ByPeriodRental Balance Period
                   deriving (Int -> LeaseRateCalc -> ShowS
[LeaseRateCalc] -> ShowS
LeaseRateCalc -> [Char]
(Int -> LeaseRateCalc -> ShowS)
-> (LeaseRateCalc -> [Char])
-> ([LeaseRateCalc] -> ShowS)
-> Show LeaseRateCalc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeaseRateCalc -> ShowS
showsPrec :: Int -> LeaseRateCalc -> ShowS
$cshow :: LeaseRateCalc -> [Char]
show :: LeaseRateCalc -> [Char]
$cshowList :: [LeaseRateCalc] -> ShowS
showList :: [LeaseRateCalc] -> ShowS
Show,(forall x. LeaseRateCalc -> Rep LeaseRateCalc x)
-> (forall x. Rep LeaseRateCalc x -> LeaseRateCalc)
-> Generic LeaseRateCalc
forall x. Rep LeaseRateCalc x -> LeaseRateCalc
forall x. LeaseRateCalc -> Rep LeaseRateCalc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeaseRateCalc -> Rep LeaseRateCalc x
from :: forall x. LeaseRateCalc -> Rep LeaseRateCalc x
$cto :: forall x. Rep LeaseRateCalc x -> LeaseRateCalc
to :: forall x. Rep LeaseRateCalc x -> LeaseRateCalc
Generic,LeaseRateCalc -> LeaseRateCalc -> Bool
(LeaseRateCalc -> LeaseRateCalc -> Bool)
-> (LeaseRateCalc -> LeaseRateCalc -> Bool) -> Eq LeaseRateCalc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeaseRateCalc -> LeaseRateCalc -> Bool
== :: LeaseRateCalc -> LeaseRateCalc -> Bool
$c/= :: LeaseRateCalc -> LeaseRateCalc -> Bool
/= :: LeaseRateCalc -> LeaseRateCalc -> Bool
Eq,Eq LeaseRateCalc
Eq LeaseRateCalc =>
(LeaseRateCalc -> LeaseRateCalc -> Ordering)
-> (LeaseRateCalc -> LeaseRateCalc -> Bool)
-> (LeaseRateCalc -> LeaseRateCalc -> Bool)
-> (LeaseRateCalc -> LeaseRateCalc -> Bool)
-> (LeaseRateCalc -> LeaseRateCalc -> Bool)
-> (LeaseRateCalc -> LeaseRateCalc -> LeaseRateCalc)
-> (LeaseRateCalc -> LeaseRateCalc -> LeaseRateCalc)
-> Ord LeaseRateCalc
LeaseRateCalc -> LeaseRateCalc -> Bool
LeaseRateCalc -> LeaseRateCalc -> Ordering
LeaseRateCalc -> LeaseRateCalc -> LeaseRateCalc
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 :: LeaseRateCalc -> LeaseRateCalc -> Ordering
compare :: LeaseRateCalc -> LeaseRateCalc -> Ordering
$c< :: LeaseRateCalc -> LeaseRateCalc -> Bool
< :: LeaseRateCalc -> LeaseRateCalc -> Bool
$c<= :: LeaseRateCalc -> LeaseRateCalc -> Bool
<= :: LeaseRateCalc -> LeaseRateCalc -> Bool
$c> :: LeaseRateCalc -> LeaseRateCalc -> Bool
> :: LeaseRateCalc -> LeaseRateCalc -> Bool
$c>= :: LeaseRateCalc -> LeaseRateCalc -> Bool
>= :: LeaseRateCalc -> LeaseRateCalc -> Bool
$cmax :: LeaseRateCalc -> LeaseRateCalc -> LeaseRateCalc
max :: LeaseRateCalc -> LeaseRateCalc -> LeaseRateCalc
$cmin :: LeaseRateCalc -> LeaseRateCalc -> LeaseRateCalc
min :: LeaseRateCalc -> LeaseRateCalc -> LeaseRateCalc
Ord)


data OriginalInfo = MortgageOriginalInfo { OriginalInfo -> Balance
originBalance :: Balance
                                          ,OriginalInfo -> RateType
originRate :: IR.RateType
                                          ,OriginalInfo -> Int
originTerm :: Int
                                          ,OriginalInfo -> Period
period :: Period
                                          ,OriginalInfo -> Date
startDate :: Date
                                          ,OriginalInfo -> AmortPlan
prinType :: AmortPlan 
                                          ,OriginalInfo -> Maybe PrepayPenaltyType
prepaymentPenalty :: Maybe PrepayPenaltyType
                                          ,OriginalInfo -> Maybe Obligor
obligor :: Maybe Obligor }
                  | LoanOriginalInfo { originBalance :: Balance
                                      ,originRate :: IR.RateType
                                      ,originTerm :: Int
                                      ,period :: Period
                                      ,startDate :: Date
                                      ,prinType :: AmortPlan 
                                      ,obligor :: Maybe Obligor }
                  | LeaseInfo { startDate :: Date            -- ^ lease start date
                              ,originTerm :: Int             -- ^ total terms
                              ,OriginalInfo -> LeaseRateCalc
originRental :: LeaseRateCalc -- ^ rental by day
                              ,obligor :: Maybe Obligor }       
                  | FixedAssetInfo { startDate :: Date 
                                     ,originBalance :: Balance 
                                     ,OriginalInfo -> Balance
residualBalance :: Balance
                                     ,originTerm :: Int
                                     ,period :: Period
                                     ,OriginalInfo -> AmortRule
accRule :: AmortRule
                                     ,OriginalInfo -> Capacity
capacity :: Capacity }
                  | ReceivableInfo { startDate :: Date
                                   ,originBalance :: Balance
                                   ,OriginalInfo -> Balance
originAdvance :: Balance
                                   ,OriginalInfo -> Date
dueDate :: Date
                                   ,OriginalInfo -> Maybe ReceivableFeeType
feeType :: Maybe ReceivableFeeType
                                   ,obligor :: Maybe Obligor }
                  deriving (Int -> OriginalInfo -> ShowS
[OriginalInfo] -> ShowS
OriginalInfo -> [Char]
(Int -> OriginalInfo -> ShowS)
-> (OriginalInfo -> [Char])
-> ([OriginalInfo] -> ShowS)
-> Show OriginalInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OriginalInfo -> ShowS
showsPrec :: Int -> OriginalInfo -> ShowS
$cshow :: OriginalInfo -> [Char]
show :: OriginalInfo -> [Char]
$cshowList :: [OriginalInfo] -> ShowS
showList :: [OriginalInfo] -> ShowS
Show,(forall x. OriginalInfo -> Rep OriginalInfo x)
-> (forall x. Rep OriginalInfo x -> OriginalInfo)
-> Generic OriginalInfo
forall x. Rep OriginalInfo x -> OriginalInfo
forall x. OriginalInfo -> Rep OriginalInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OriginalInfo -> Rep OriginalInfo x
from :: forall x. OriginalInfo -> Rep OriginalInfo x
$cto :: forall x. Rep OriginalInfo x -> OriginalInfo
to :: forall x. Rep OriginalInfo x -> OriginalInfo
Generic,Eq OriginalInfo
Eq OriginalInfo =>
(OriginalInfo -> OriginalInfo -> Ordering)
-> (OriginalInfo -> OriginalInfo -> Bool)
-> (OriginalInfo -> OriginalInfo -> Bool)
-> (OriginalInfo -> OriginalInfo -> Bool)
-> (OriginalInfo -> OriginalInfo -> Bool)
-> (OriginalInfo -> OriginalInfo -> OriginalInfo)
-> (OriginalInfo -> OriginalInfo -> OriginalInfo)
-> Ord OriginalInfo
OriginalInfo -> OriginalInfo -> Bool
OriginalInfo -> OriginalInfo -> Ordering
OriginalInfo -> OriginalInfo -> OriginalInfo
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 :: OriginalInfo -> OriginalInfo -> Ordering
compare :: OriginalInfo -> OriginalInfo -> Ordering
$c< :: OriginalInfo -> OriginalInfo -> Bool
< :: OriginalInfo -> OriginalInfo -> Bool
$c<= :: OriginalInfo -> OriginalInfo -> Bool
<= :: OriginalInfo -> OriginalInfo -> Bool
$c> :: OriginalInfo -> OriginalInfo -> Bool
> :: OriginalInfo -> OriginalInfo -> Bool
$c>= :: OriginalInfo -> OriginalInfo -> Bool
>= :: OriginalInfo -> OriginalInfo -> Bool
$cmax :: OriginalInfo -> OriginalInfo -> OriginalInfo
max :: OriginalInfo -> OriginalInfo -> OriginalInfo
$cmin :: OriginalInfo -> OriginalInfo -> OriginalInfo
min :: OriginalInfo -> OriginalInfo -> OriginalInfo
Ord,OriginalInfo -> OriginalInfo -> Bool
(OriginalInfo -> OriginalInfo -> Bool)
-> (OriginalInfo -> OriginalInfo -> Bool) -> Eq OriginalInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OriginalInfo -> OriginalInfo -> Bool
== :: OriginalInfo -> OriginalInfo -> Bool
$c/= :: OriginalInfo -> OriginalInfo -> Bool
/= :: OriginalInfo -> OriginalInfo -> Bool
Eq)


data Installment = Installment OriginalInfo Balance RemainTerms Status
                 | Dummy
                 deriving (Int -> Installment -> ShowS
[Installment] -> ShowS
Installment -> [Char]
(Int -> Installment -> ShowS)
-> (Installment -> [Char])
-> ([Installment] -> ShowS)
-> Show Installment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Installment -> ShowS
showsPrec :: Int -> Installment -> ShowS
$cshow :: Installment -> [Char]
show :: Installment -> [Char]
$cshowList :: [Installment] -> ShowS
showList :: [Installment] -> ShowS
Show,(forall x. Installment -> Rep Installment x)
-> (forall x. Rep Installment x -> Installment)
-> Generic Installment
forall x. Rep Installment x -> Installment
forall x. Installment -> Rep Installment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Installment -> Rep Installment x
from :: forall x. Installment -> Rep Installment x
$cto :: forall x. Rep Installment x -> Installment
to :: forall x. Rep Installment x -> Installment
Generic,Eq Installment
Eq Installment =>
(Installment -> Installment -> Ordering)
-> (Installment -> Installment -> Bool)
-> (Installment -> Installment -> Bool)
-> (Installment -> Installment -> Bool)
-> (Installment -> Installment -> Bool)
-> (Installment -> Installment -> Installment)
-> (Installment -> Installment -> Installment)
-> Ord Installment
Installment -> Installment -> Bool
Installment -> Installment -> Ordering
Installment -> Installment -> Installment
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 :: Installment -> Installment -> Ordering
compare :: Installment -> Installment -> Ordering
$c< :: Installment -> Installment -> Bool
< :: Installment -> Installment -> Bool
$c<= :: Installment -> Installment -> Bool
<= :: Installment -> Installment -> Bool
$c> :: Installment -> Installment -> Bool
> :: Installment -> Installment -> Bool
$c>= :: Installment -> Installment -> Bool
>= :: Installment -> Installment -> Bool
$cmax :: Installment -> Installment -> Installment
max :: Installment -> Installment -> Installment
$cmin :: Installment -> Installment -> Installment
min :: Installment -> Installment -> Installment
Ord,Installment -> Installment -> Bool
(Installment -> Installment -> Bool)
-> (Installment -> Installment -> Bool) -> Eq Installment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Installment -> Installment -> Bool
== :: Installment -> Installment -> Bool
$c/= :: Installment -> Installment -> Bool
/= :: Installment -> Installment -> Bool
Eq)

data LeaseStepUp = FlatRate Rate
                 | ByRateCurve [Rate]
                 | ByFlatAmount Balance
                 | ByAmountCurve [Balance]
                 deriving (Int -> LeaseStepUp -> ShowS
[LeaseStepUp] -> ShowS
LeaseStepUp -> [Char]
(Int -> LeaseStepUp -> ShowS)
-> (LeaseStepUp -> [Char])
-> ([LeaseStepUp] -> ShowS)
-> Show LeaseStepUp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeaseStepUp -> ShowS
showsPrec :: Int -> LeaseStepUp -> ShowS
$cshow :: LeaseStepUp -> [Char]
show :: LeaseStepUp -> [Char]
$cshowList :: [LeaseStepUp] -> ShowS
showList :: [LeaseStepUp] -> ShowS
Show,(forall x. LeaseStepUp -> Rep LeaseStepUp x)
-> (forall x. Rep LeaseStepUp x -> LeaseStepUp)
-> Generic LeaseStepUp
forall x. Rep LeaseStepUp x -> LeaseStepUp
forall x. LeaseStepUp -> Rep LeaseStepUp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeaseStepUp -> Rep LeaseStepUp x
from :: forall x. LeaseStepUp -> Rep LeaseStepUp x
$cto :: forall x. Rep LeaseStepUp x -> LeaseStepUp
to :: forall x. Rep LeaseStepUp x -> LeaseStepUp
Generic,Eq LeaseStepUp
Eq LeaseStepUp =>
(LeaseStepUp -> LeaseStepUp -> Ordering)
-> (LeaseStepUp -> LeaseStepUp -> Bool)
-> (LeaseStepUp -> LeaseStepUp -> Bool)
-> (LeaseStepUp -> LeaseStepUp -> Bool)
-> (LeaseStepUp -> LeaseStepUp -> Bool)
-> (LeaseStepUp -> LeaseStepUp -> LeaseStepUp)
-> (LeaseStepUp -> LeaseStepUp -> LeaseStepUp)
-> Ord LeaseStepUp
LeaseStepUp -> LeaseStepUp -> Bool
LeaseStepUp -> LeaseStepUp -> Ordering
LeaseStepUp -> LeaseStepUp -> LeaseStepUp
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 :: LeaseStepUp -> LeaseStepUp -> Ordering
compare :: LeaseStepUp -> LeaseStepUp -> Ordering
$c< :: LeaseStepUp -> LeaseStepUp -> Bool
< :: LeaseStepUp -> LeaseStepUp -> Bool
$c<= :: LeaseStepUp -> LeaseStepUp -> Bool
<= :: LeaseStepUp -> LeaseStepUp -> Bool
$c> :: LeaseStepUp -> LeaseStepUp -> Bool
> :: LeaseStepUp -> LeaseStepUp -> Bool
$c>= :: LeaseStepUp -> LeaseStepUp -> Bool
>= :: LeaseStepUp -> LeaseStepUp -> Bool
$cmax :: LeaseStepUp -> LeaseStepUp -> LeaseStepUp
max :: LeaseStepUp -> LeaseStepUp -> LeaseStepUp
$cmin :: LeaseStepUp -> LeaseStepUp -> LeaseStepUp
min :: LeaseStepUp -> LeaseStepUp -> LeaseStepUp
Ord,LeaseStepUp -> LeaseStepUp -> Bool
(LeaseStepUp -> LeaseStepUp -> Bool)
-> (LeaseStepUp -> LeaseStepUp -> Bool) -> Eq LeaseStepUp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeaseStepUp -> LeaseStepUp -> Bool
== :: LeaseStepUp -> LeaseStepUp -> Bool
$c/= :: LeaseStepUp -> LeaseStepUp -> Bool
/= :: LeaseStepUp -> LeaseStepUp -> Bool
Eq)

data Lease = RegularLease OriginalInfo Balance RemainTerms Status
           | StepUpLease OriginalInfo LeaseStepUp Balance RemainTerms Status
           deriving (Int -> Lease -> ShowS
[Lease] -> ShowS
Lease -> [Char]
(Int -> Lease -> ShowS)
-> (Lease -> [Char]) -> ([Lease] -> ShowS) -> Show Lease
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lease -> ShowS
showsPrec :: Int -> Lease -> ShowS
$cshow :: Lease -> [Char]
show :: Lease -> [Char]
$cshowList :: [Lease] -> ShowS
showList :: [Lease] -> ShowS
Show,(forall x. Lease -> Rep Lease x)
-> (forall x. Rep Lease x -> Lease) -> Generic Lease
forall x. Rep Lease x -> Lease
forall x. Lease -> Rep Lease x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Lease -> Rep Lease x
from :: forall x. Lease -> Rep Lease x
$cto :: forall x. Rep Lease x -> Lease
to :: forall x. Rep Lease x -> Lease
Generic,Lease -> Lease -> Bool
(Lease -> Lease -> Bool) -> (Lease -> Lease -> Bool) -> Eq Lease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lease -> Lease -> Bool
== :: Lease -> Lease -> Bool
$c/= :: Lease -> Lease -> Bool
/= :: Lease -> Lease -> Bool
Eq,Eq Lease
Eq Lease =>
(Lease -> Lease -> Ordering)
-> (Lease -> Lease -> Bool)
-> (Lease -> Lease -> Bool)
-> (Lease -> Lease -> Bool)
-> (Lease -> Lease -> Bool)
-> (Lease -> Lease -> Lease)
-> (Lease -> Lease -> Lease)
-> Ord Lease
Lease -> Lease -> Bool
Lease -> Lease -> Ordering
Lease -> Lease -> Lease
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 :: Lease -> Lease -> Ordering
compare :: Lease -> Lease -> Ordering
$c< :: Lease -> Lease -> Bool
< :: Lease -> Lease -> Bool
$c<= :: Lease -> Lease -> Bool
<= :: Lease -> Lease -> Bool
$c> :: Lease -> Lease -> Bool
> :: Lease -> Lease -> Bool
$c>= :: Lease -> Lease -> Bool
>= :: Lease -> Lease -> Bool
$cmax :: Lease -> Lease -> Lease
max :: Lease -> Lease -> Lease
$cmin :: Lease -> Lease -> Lease
min :: Lease -> Lease -> Lease
Ord)

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

instance TimeSeries AccrualPeriod where 
    getDate :: AccrualPeriod -> Date
getDate (AccrualPeriod Date
d Balance
_) = Date
d

data Loan = PersonalLoan OriginalInfo Balance IRate RemainTerms Status
          | DUMMY
          deriving (Int -> Loan -> ShowS
[Loan] -> ShowS
Loan -> [Char]
(Int -> Loan -> ShowS)
-> (Loan -> [Char]) -> ([Loan] -> ShowS) -> Show Loan
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Loan -> ShowS
showsPrec :: Int -> Loan -> ShowS
$cshow :: Loan -> [Char]
show :: Loan -> [Char]
$cshowList :: [Loan] -> ShowS
showList :: [Loan] -> ShowS
Show,(forall x. Loan -> Rep Loan x)
-> (forall x. Rep Loan x -> Loan) -> Generic Loan
forall x. Rep Loan x -> Loan
forall x. Loan -> Rep Loan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Loan -> Rep Loan x
from :: forall x. Loan -> Rep Loan x
$cto :: forall x. Rep Loan x -> Loan
to :: forall x. Rep Loan x -> Loan
Generic,Eq Loan
Eq Loan =>
(Loan -> Loan -> Ordering)
-> (Loan -> Loan -> Bool)
-> (Loan -> Loan -> Bool)
-> (Loan -> Loan -> Bool)
-> (Loan -> Loan -> Bool)
-> (Loan -> Loan -> Loan)
-> (Loan -> Loan -> Loan)
-> Ord Loan
Loan -> Loan -> Bool
Loan -> Loan -> Ordering
Loan -> Loan -> Loan
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 :: Loan -> Loan -> Ordering
compare :: Loan -> Loan -> Ordering
$c< :: Loan -> Loan -> Bool
< :: Loan -> Loan -> Bool
$c<= :: Loan -> Loan -> Bool
<= :: Loan -> Loan -> Bool
$c> :: Loan -> Loan -> Bool
> :: Loan -> Loan -> Bool
$c>= :: Loan -> Loan -> Bool
>= :: Loan -> Loan -> Bool
$cmax :: Loan -> Loan -> Loan
max :: Loan -> Loan -> Loan
$cmin :: Loan -> Loan -> Loan
min :: Loan -> Loan -> Loan
Ord,Loan -> Loan -> Bool
(Loan -> Loan -> Bool) -> (Loan -> Loan -> Bool) -> Eq Loan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Loan -> Loan -> Bool
== :: Loan -> Loan -> Bool
$c/= :: Loan -> Loan -> Bool
/= :: Loan -> Loan -> Bool
Eq)

data Mortgage = Mortgage OriginalInfo Balance IRate RemainTerms (Maybe BorrowerNum) Status
              | AdjustRateMortgage OriginalInfo IR.ARM Balance IRate RemainTerms (Maybe BorrowerNum) Status
              | ScheduleMortgageFlow Date [CF.TsRow] DatePattern
              deriving (Int -> Mortgage -> ShowS
[Mortgage] -> ShowS
Mortgage -> [Char]
(Int -> Mortgage -> ShowS)
-> (Mortgage -> [Char]) -> ([Mortgage] -> ShowS) -> Show Mortgage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mortgage -> ShowS
showsPrec :: Int -> Mortgage -> ShowS
$cshow :: Mortgage -> [Char]
show :: Mortgage -> [Char]
$cshowList :: [Mortgage] -> ShowS
showList :: [Mortgage] -> ShowS
Show,(forall x. Mortgage -> Rep Mortgage x)
-> (forall x. Rep Mortgage x -> Mortgage) -> Generic Mortgage
forall x. Rep Mortgage x -> Mortgage
forall x. Mortgage -> Rep Mortgage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mortgage -> Rep Mortgage x
from :: forall x. Mortgage -> Rep Mortgage x
$cto :: forall x. Rep Mortgage x -> Mortgage
to :: forall x. Rep Mortgage x -> Mortgage
Generic,Mortgage -> Mortgage -> Bool
(Mortgage -> Mortgage -> Bool)
-> (Mortgage -> Mortgage -> Bool) -> Eq Mortgage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mortgage -> Mortgage -> Bool
== :: Mortgage -> Mortgage -> Bool
$c/= :: Mortgage -> Mortgage -> Bool
/= :: Mortgage -> Mortgage -> Bool
Eq,Eq Mortgage
Eq Mortgage =>
(Mortgage -> Mortgage -> Ordering)
-> (Mortgage -> Mortgage -> Bool)
-> (Mortgage -> Mortgage -> Bool)
-> (Mortgage -> Mortgage -> Bool)
-> (Mortgage -> Mortgage -> Bool)
-> (Mortgage -> Mortgage -> Mortgage)
-> (Mortgage -> Mortgage -> Mortgage)
-> Ord Mortgage
Mortgage -> Mortgage -> Bool
Mortgage -> Mortgage -> Ordering
Mortgage -> Mortgage -> Mortgage
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 :: Mortgage -> Mortgage -> Ordering
compare :: Mortgage -> Mortgage -> Ordering
$c< :: Mortgage -> Mortgage -> Bool
< :: Mortgage -> Mortgage -> Bool
$c<= :: Mortgage -> Mortgage -> Bool
<= :: Mortgage -> Mortgage -> Bool
$c> :: Mortgage -> Mortgage -> Bool
> :: Mortgage -> Mortgage -> Bool
$c>= :: Mortgage -> Mortgage -> Bool
>= :: Mortgage -> Mortgage -> Bool
$cmax :: Mortgage -> Mortgage -> Mortgage
max :: Mortgage -> Mortgage -> Mortgage
$cmin :: Mortgage -> Mortgage -> Mortgage
min :: Mortgage -> Mortgage -> Mortgage
Ord)


type FixRatePortion   = (Rate, IRate)
type FloatRatePortion = (Rate, Spread, Index)


data ProjectedCashflow = ProjectedFlowFixed CF.CashFlowFrame DatePattern
                       | ProjectedFlowMixFloater CF.CashFlowFrame DatePattern FixRatePortion [FloatRatePortion]
                       deriving (Int -> ProjectedCashflow -> ShowS
[ProjectedCashflow] -> ShowS
ProjectedCashflow -> [Char]
(Int -> ProjectedCashflow -> ShowS)
-> (ProjectedCashflow -> [Char])
-> ([ProjectedCashflow] -> ShowS)
-> Show ProjectedCashflow
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectedCashflow -> ShowS
showsPrec :: Int -> ProjectedCashflow -> ShowS
$cshow :: ProjectedCashflow -> [Char]
show :: ProjectedCashflow -> [Char]
$cshowList :: [ProjectedCashflow] -> ShowS
showList :: [ProjectedCashflow] -> ShowS
Show,(forall x. ProjectedCashflow -> Rep ProjectedCashflow x)
-> (forall x. Rep ProjectedCashflow x -> ProjectedCashflow)
-> Generic ProjectedCashflow
forall x. Rep ProjectedCashflow x -> ProjectedCashflow
forall x. ProjectedCashflow -> Rep ProjectedCashflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjectedCashflow -> Rep ProjectedCashflow x
from :: forall x. ProjectedCashflow -> Rep ProjectedCashflow x
$cto :: forall x. Rep ProjectedCashflow x -> ProjectedCashflow
to :: forall x. Rep ProjectedCashflow x -> ProjectedCashflow
Generic,ProjectedCashflow -> ProjectedCashflow -> Bool
(ProjectedCashflow -> ProjectedCashflow -> Bool)
-> (ProjectedCashflow -> ProjectedCashflow -> Bool)
-> Eq ProjectedCashflow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectedCashflow -> ProjectedCashflow -> Bool
== :: ProjectedCashflow -> ProjectedCashflow -> Bool
$c/= :: ProjectedCashflow -> ProjectedCashflow -> Bool
/= :: ProjectedCashflow -> ProjectedCashflow -> Bool
Eq,Eq ProjectedCashflow
Eq ProjectedCashflow =>
(ProjectedCashflow -> ProjectedCashflow -> Ordering)
-> (ProjectedCashflow -> ProjectedCashflow -> Bool)
-> (ProjectedCashflow -> ProjectedCashflow -> Bool)
-> (ProjectedCashflow -> ProjectedCashflow -> Bool)
-> (ProjectedCashflow -> ProjectedCashflow -> Bool)
-> (ProjectedCashflow -> ProjectedCashflow -> ProjectedCashflow)
-> (ProjectedCashflow -> ProjectedCashflow -> ProjectedCashflow)
-> Ord ProjectedCashflow
ProjectedCashflow -> ProjectedCashflow -> Bool
ProjectedCashflow -> ProjectedCashflow -> Ordering
ProjectedCashflow -> ProjectedCashflow -> ProjectedCashflow
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 :: ProjectedCashflow -> ProjectedCashflow -> Ordering
compare :: ProjectedCashflow -> ProjectedCashflow -> Ordering
$c< :: ProjectedCashflow -> ProjectedCashflow -> Bool
< :: ProjectedCashflow -> ProjectedCashflow -> Bool
$c<= :: ProjectedCashflow -> ProjectedCashflow -> Bool
<= :: ProjectedCashflow -> ProjectedCashflow -> Bool
$c> :: ProjectedCashflow -> ProjectedCashflow -> Bool
> :: ProjectedCashflow -> ProjectedCashflow -> Bool
$c>= :: ProjectedCashflow -> ProjectedCashflow -> Bool
>= :: ProjectedCashflow -> ProjectedCashflow -> Bool
$cmax :: ProjectedCashflow -> ProjectedCashflow -> ProjectedCashflow
max :: ProjectedCashflow -> ProjectedCashflow -> ProjectedCashflow
$cmin :: ProjectedCashflow -> ProjectedCashflow -> ProjectedCashflow
min :: ProjectedCashflow -> ProjectedCashflow -> ProjectedCashflow
Ord)


data Receivable = Invoice OriginalInfo Status
                | DUMMY4
                deriving (Int -> Receivable -> ShowS
[Receivable] -> ShowS
Receivable -> [Char]
(Int -> Receivable -> ShowS)
-> (Receivable -> [Char])
-> ([Receivable] -> ShowS)
-> Show Receivable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Receivable -> ShowS
showsPrec :: Int -> Receivable -> ShowS
$cshow :: Receivable -> [Char]
show :: Receivable -> [Char]
$cshowList :: [Receivable] -> ShowS
showList :: [Receivable] -> ShowS
Show,(forall x. Receivable -> Rep Receivable x)
-> (forall x. Rep Receivable x -> Receivable) -> Generic Receivable
forall x. Rep Receivable x -> Receivable
forall x. Receivable -> Rep Receivable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Receivable -> Rep Receivable x
from :: forall x. Receivable -> Rep Receivable x
$cto :: forall x. Rep Receivable x -> Receivable
to :: forall x. Rep Receivable x -> Receivable
Generic,Receivable -> Receivable -> Bool
(Receivable -> Receivable -> Bool)
-> (Receivable -> Receivable -> Bool) -> Eq Receivable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Receivable -> Receivable -> Bool
== :: Receivable -> Receivable -> Bool
$c/= :: Receivable -> Receivable -> Bool
/= :: Receivable -> Receivable -> Bool
Eq,Eq Receivable
Eq Receivable =>
(Receivable -> Receivable -> Ordering)
-> (Receivable -> Receivable -> Bool)
-> (Receivable -> Receivable -> Bool)
-> (Receivable -> Receivable -> Bool)
-> (Receivable -> Receivable -> Bool)
-> (Receivable -> Receivable -> Receivable)
-> (Receivable -> Receivable -> Receivable)
-> Ord Receivable
Receivable -> Receivable -> Bool
Receivable -> Receivable -> Ordering
Receivable -> Receivable -> Receivable
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 :: Receivable -> Receivable -> Ordering
compare :: Receivable -> Receivable -> Ordering
$c< :: Receivable -> Receivable -> Bool
< :: Receivable -> Receivable -> Bool
$c<= :: Receivable -> Receivable -> Bool
<= :: Receivable -> Receivable -> Bool
$c> :: Receivable -> Receivable -> Bool
> :: Receivable -> Receivable -> Bool
$c>= :: Receivable -> Receivable -> Bool
>= :: Receivable -> Receivable -> Bool
$cmax :: Receivable -> Receivable -> Receivable
max :: Receivable -> Receivable -> Receivable
$cmin :: Receivable -> Receivable -> Receivable
min :: Receivable -> Receivable -> Receivable
Ord)

data MixedAsset = MixedPool (Map.Map String [AssetUnion])
                | DUMMY2
                deriving (Int -> MixedAsset -> ShowS
[MixedAsset] -> ShowS
MixedAsset -> [Char]
(Int -> MixedAsset -> ShowS)
-> (MixedAsset -> [Char])
-> ([MixedAsset] -> ShowS)
-> Show MixedAsset
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MixedAsset -> ShowS
showsPrec :: Int -> MixedAsset -> ShowS
$cshow :: MixedAsset -> [Char]
show :: MixedAsset -> [Char]
$cshowList :: [MixedAsset] -> ShowS
showList :: [MixedAsset] -> ShowS
Show,(forall x. MixedAsset -> Rep MixedAsset x)
-> (forall x. Rep MixedAsset x -> MixedAsset) -> Generic MixedAsset
forall x. Rep MixedAsset x -> MixedAsset
forall x. MixedAsset -> Rep MixedAsset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MixedAsset -> Rep MixedAsset x
from :: forall x. MixedAsset -> Rep MixedAsset x
$cto :: forall x. Rep MixedAsset x -> MixedAsset
to :: forall x. Rep MixedAsset x -> MixedAsset
Generic,MixedAsset -> MixedAsset -> Bool
(MixedAsset -> MixedAsset -> Bool)
-> (MixedAsset -> MixedAsset -> Bool) -> Eq MixedAsset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MixedAsset -> MixedAsset -> Bool
== :: MixedAsset -> MixedAsset -> Bool
$c/= :: MixedAsset -> MixedAsset -> Bool
/= :: MixedAsset -> MixedAsset -> Bool
Eq,Eq MixedAsset
Eq MixedAsset =>
(MixedAsset -> MixedAsset -> Ordering)
-> (MixedAsset -> MixedAsset -> Bool)
-> (MixedAsset -> MixedAsset -> Bool)
-> (MixedAsset -> MixedAsset -> Bool)
-> (MixedAsset -> MixedAsset -> Bool)
-> (MixedAsset -> MixedAsset -> MixedAsset)
-> (MixedAsset -> MixedAsset -> MixedAsset)
-> Ord MixedAsset
MixedAsset -> MixedAsset -> Bool
MixedAsset -> MixedAsset -> Ordering
MixedAsset -> MixedAsset -> MixedAsset
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 :: MixedAsset -> MixedAsset -> Ordering
compare :: MixedAsset -> MixedAsset -> Ordering
$c< :: MixedAsset -> MixedAsset -> Bool
< :: MixedAsset -> MixedAsset -> Bool
$c<= :: MixedAsset -> MixedAsset -> Bool
<= :: MixedAsset -> MixedAsset -> Bool
$c> :: MixedAsset -> MixedAsset -> Bool
> :: MixedAsset -> MixedAsset -> Bool
$c>= :: MixedAsset -> MixedAsset -> Bool
>= :: MixedAsset -> MixedAsset -> Bool
$cmax :: MixedAsset -> MixedAsset -> MixedAsset
max :: MixedAsset -> MixedAsset -> MixedAsset
$cmin :: MixedAsset -> MixedAsset -> MixedAsset
min :: MixedAsset -> MixedAsset -> MixedAsset
Ord)

type LineOfCredit = Maybe Balance

data Revolver = Heloc OriginalInfo LineOfCredit Balance IRate RemainTerms (Maybe BorrowerNum) Status
              | DUMMY5
              deriving (Int -> Revolver -> ShowS
[Revolver] -> ShowS
Revolver -> [Char]
(Int -> Revolver -> ShowS)
-> (Revolver -> [Char]) -> ([Revolver] -> ShowS) -> Show Revolver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Revolver -> ShowS
showsPrec :: Int -> Revolver -> ShowS
$cshow :: Revolver -> [Char]
show :: Revolver -> [Char]
$cshowList :: [Revolver] -> ShowS
showList :: [Revolver] -> ShowS
Show,(forall x. Revolver -> Rep Revolver x)
-> (forall x. Rep Revolver x -> Revolver) -> Generic Revolver
forall x. Rep Revolver x -> Revolver
forall x. Revolver -> Rep Revolver x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Revolver -> Rep Revolver x
from :: forall x. Revolver -> Rep Revolver x
$cto :: forall x. Rep Revolver x -> Revolver
to :: forall x. Rep Revolver x -> Revolver
Generic,Revolver -> Revolver -> Bool
(Revolver -> Revolver -> Bool)
-> (Revolver -> Revolver -> Bool) -> Eq Revolver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Revolver -> Revolver -> Bool
== :: Revolver -> Revolver -> Bool
$c/= :: Revolver -> Revolver -> Bool
/= :: Revolver -> Revolver -> Bool
Eq,Eq Revolver
Eq Revolver =>
(Revolver -> Revolver -> Ordering)
-> (Revolver -> Revolver -> Bool)
-> (Revolver -> Revolver -> Bool)
-> (Revolver -> Revolver -> Bool)
-> (Revolver -> Revolver -> Bool)
-> (Revolver -> Revolver -> Revolver)
-> (Revolver -> Revolver -> Revolver)
-> Ord Revolver
Revolver -> Revolver -> Bool
Revolver -> Revolver -> Ordering
Revolver -> Revolver -> Revolver
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 :: Revolver -> Revolver -> Ordering
compare :: Revolver -> Revolver -> Ordering
$c< :: Revolver -> Revolver -> Bool
< :: Revolver -> Revolver -> Bool
$c<= :: Revolver -> Revolver -> Bool
<= :: Revolver -> Revolver -> Bool
$c> :: Revolver -> Revolver -> Bool
> :: Revolver -> Revolver -> Bool
$c>= :: Revolver -> Revolver -> Bool
>= :: Revolver -> Revolver -> Bool
$cmax :: Revolver -> Revolver -> Revolver
max :: Revolver -> Revolver -> Revolver
$cmin :: Revolver -> Revolver -> Revolver
min :: Revolver -> Revolver -> Revolver
Ord)

-- FixedAsset 
data Capacity = FixedCapacity Balance
              | CapacityByTerm [(Int,Balance)]
              deriving (Int -> Capacity -> ShowS
[Capacity] -> ShowS
Capacity -> [Char]
(Int -> Capacity -> ShowS)
-> (Capacity -> [Char]) -> ([Capacity] -> ShowS) -> Show Capacity
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Capacity -> ShowS
showsPrec :: Int -> Capacity -> ShowS
$cshow :: Capacity -> [Char]
show :: Capacity -> [Char]
$cshowList :: [Capacity] -> ShowS
showList :: [Capacity] -> ShowS
Show,(forall x. Capacity -> Rep Capacity x)
-> (forall x. Rep Capacity x -> Capacity) -> Generic Capacity
forall x. Rep Capacity x -> Capacity
forall x. Capacity -> Rep Capacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Capacity -> Rep Capacity x
from :: forall x. Capacity -> Rep Capacity x
$cto :: forall x. Rep Capacity x -> Capacity
to :: forall x. Rep Capacity x -> Capacity
Generic,Eq Capacity
Eq Capacity =>
(Capacity -> Capacity -> Ordering)
-> (Capacity -> Capacity -> Bool)
-> (Capacity -> Capacity -> Bool)
-> (Capacity -> Capacity -> Bool)
-> (Capacity -> Capacity -> Bool)
-> (Capacity -> Capacity -> Capacity)
-> (Capacity -> Capacity -> Capacity)
-> Ord Capacity
Capacity -> Capacity -> Bool
Capacity -> Capacity -> Ordering
Capacity -> Capacity -> Capacity
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 :: Capacity -> Capacity -> Ordering
compare :: Capacity -> Capacity -> Ordering
$c< :: Capacity -> Capacity -> Bool
< :: Capacity -> Capacity -> Bool
$c<= :: Capacity -> Capacity -> Bool
<= :: Capacity -> Capacity -> Bool
$c> :: Capacity -> Capacity -> Bool
> :: Capacity -> Capacity -> Bool
$c>= :: Capacity -> Capacity -> Bool
>= :: Capacity -> Capacity -> Bool
$cmax :: Capacity -> Capacity -> Capacity
max :: Capacity -> Capacity -> Capacity
$cmin :: Capacity -> Capacity -> Capacity
min :: Capacity -> Capacity -> Capacity
Ord,Capacity -> Capacity -> Bool
(Capacity -> Capacity -> Bool)
-> (Capacity -> Capacity -> Bool) -> Eq Capacity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Capacity -> Capacity -> Bool
== :: Capacity -> Capacity -> Bool
$c/= :: Capacity -> Capacity -> Bool
/= :: Capacity -> Capacity -> Bool
Eq)

data AssociateExp = ExpPerPeriod Balance 
                  | ExpPerUnit Balance
                  deriving (Int -> AssociateExp -> ShowS
[AssociateExp] -> ShowS
AssociateExp -> [Char]
(Int -> AssociateExp -> ShowS)
-> (AssociateExp -> [Char])
-> ([AssociateExp] -> ShowS)
-> Show AssociateExp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssociateExp -> ShowS
showsPrec :: Int -> AssociateExp -> ShowS
$cshow :: AssociateExp -> [Char]
show :: AssociateExp -> [Char]
$cshowList :: [AssociateExp] -> ShowS
showList :: [AssociateExp] -> ShowS
Show,(forall x. AssociateExp -> Rep AssociateExp x)
-> (forall x. Rep AssociateExp x -> AssociateExp)
-> Generic AssociateExp
forall x. Rep AssociateExp x -> AssociateExp
forall x. AssociateExp -> Rep AssociateExp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssociateExp -> Rep AssociateExp x
from :: forall x. AssociateExp -> Rep AssociateExp x
$cto :: forall x. Rep AssociateExp x -> AssociateExp
to :: forall x. Rep AssociateExp x -> AssociateExp
Generic,Eq AssociateExp
Eq AssociateExp =>
(AssociateExp -> AssociateExp -> Ordering)
-> (AssociateExp -> AssociateExp -> Bool)
-> (AssociateExp -> AssociateExp -> Bool)
-> (AssociateExp -> AssociateExp -> Bool)
-> (AssociateExp -> AssociateExp -> Bool)
-> (AssociateExp -> AssociateExp -> AssociateExp)
-> (AssociateExp -> AssociateExp -> AssociateExp)
-> Ord AssociateExp
AssociateExp -> AssociateExp -> Bool
AssociateExp -> AssociateExp -> Ordering
AssociateExp -> AssociateExp -> AssociateExp
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 :: AssociateExp -> AssociateExp -> Ordering
compare :: AssociateExp -> AssociateExp -> Ordering
$c< :: AssociateExp -> AssociateExp -> Bool
< :: AssociateExp -> AssociateExp -> Bool
$c<= :: AssociateExp -> AssociateExp -> Bool
<= :: AssociateExp -> AssociateExp -> Bool
$c> :: AssociateExp -> AssociateExp -> Bool
> :: AssociateExp -> AssociateExp -> Bool
$c>= :: AssociateExp -> AssociateExp -> Bool
>= :: AssociateExp -> AssociateExp -> Bool
$cmax :: AssociateExp -> AssociateExp -> AssociateExp
max :: AssociateExp -> AssociateExp -> AssociateExp
$cmin :: AssociateExp -> AssociateExp -> AssociateExp
min :: AssociateExp -> AssociateExp -> AssociateExp
Ord,AssociateExp -> AssociateExp -> Bool
(AssociateExp -> AssociateExp -> Bool)
-> (AssociateExp -> AssociateExp -> Bool) -> Eq AssociateExp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssociateExp -> AssociateExp -> Bool
== :: AssociateExp -> AssociateExp -> Bool
$c/= :: AssociateExp -> AssociateExp -> Bool
/= :: AssociateExp -> AssociateExp -> Bool
Eq)

data AssociateIncome = IncomePerPeriod Balance 
                      | IncomePerUnit Balance
                      deriving (Int -> AssociateIncome -> ShowS
[AssociateIncome] -> ShowS
AssociateIncome -> [Char]
(Int -> AssociateIncome -> ShowS)
-> (AssociateIncome -> [Char])
-> ([AssociateIncome] -> ShowS)
-> Show AssociateIncome
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssociateIncome -> ShowS
showsPrec :: Int -> AssociateIncome -> ShowS
$cshow :: AssociateIncome -> [Char]
show :: AssociateIncome -> [Char]
$cshowList :: [AssociateIncome] -> ShowS
showList :: [AssociateIncome] -> ShowS
Show,(forall x. AssociateIncome -> Rep AssociateIncome x)
-> (forall x. Rep AssociateIncome x -> AssociateIncome)
-> Generic AssociateIncome
forall x. Rep AssociateIncome x -> AssociateIncome
forall x. AssociateIncome -> Rep AssociateIncome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssociateIncome -> Rep AssociateIncome x
from :: forall x. AssociateIncome -> Rep AssociateIncome x
$cto :: forall x. Rep AssociateIncome x -> AssociateIncome
to :: forall x. Rep AssociateIncome x -> AssociateIncome
Generic,Eq AssociateIncome
Eq AssociateIncome =>
(AssociateIncome -> AssociateIncome -> Ordering)
-> (AssociateIncome -> AssociateIncome -> Bool)
-> (AssociateIncome -> AssociateIncome -> Bool)
-> (AssociateIncome -> AssociateIncome -> Bool)
-> (AssociateIncome -> AssociateIncome -> Bool)
-> (AssociateIncome -> AssociateIncome -> AssociateIncome)
-> (AssociateIncome -> AssociateIncome -> AssociateIncome)
-> Ord AssociateIncome
AssociateIncome -> AssociateIncome -> Bool
AssociateIncome -> AssociateIncome -> Ordering
AssociateIncome -> AssociateIncome -> AssociateIncome
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 :: AssociateIncome -> AssociateIncome -> Ordering
compare :: AssociateIncome -> AssociateIncome -> Ordering
$c< :: AssociateIncome -> AssociateIncome -> Bool
< :: AssociateIncome -> AssociateIncome -> Bool
$c<= :: AssociateIncome -> AssociateIncome -> Bool
<= :: AssociateIncome -> AssociateIncome -> Bool
$c> :: AssociateIncome -> AssociateIncome -> Bool
> :: AssociateIncome -> AssociateIncome -> Bool
$c>= :: AssociateIncome -> AssociateIncome -> Bool
>= :: AssociateIncome -> AssociateIncome -> Bool
$cmax :: AssociateIncome -> AssociateIncome -> AssociateIncome
max :: AssociateIncome -> AssociateIncome -> AssociateIncome
$cmin :: AssociateIncome -> AssociateIncome -> AssociateIncome
min :: AssociateIncome -> AssociateIncome -> AssociateIncome
Ord,AssociateIncome -> AssociateIncome -> Bool
(AssociateIncome -> AssociateIncome -> Bool)
-> (AssociateIncome -> AssociateIncome -> Bool)
-> Eq AssociateIncome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssociateIncome -> AssociateIncome -> Bool
== :: AssociateIncome -> AssociateIncome -> Bool
$c/= :: AssociateIncome -> AssociateIncome -> Bool
/= :: AssociateIncome -> AssociateIncome -> Bool
Eq)

data FixedAsset = FixedAsset OriginalInfo Balance RemainTerms
                | Dummy5
                deriving (Int -> FixedAsset -> ShowS
[FixedAsset] -> ShowS
FixedAsset -> [Char]
(Int -> FixedAsset -> ShowS)
-> (FixedAsset -> [Char])
-> ([FixedAsset] -> ShowS)
-> Show FixedAsset
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixedAsset -> ShowS
showsPrec :: Int -> FixedAsset -> ShowS
$cshow :: FixedAsset -> [Char]
show :: FixedAsset -> [Char]
$cshowList :: [FixedAsset] -> ShowS
showList :: [FixedAsset] -> ShowS
Show,(forall x. FixedAsset -> Rep FixedAsset x)
-> (forall x. Rep FixedAsset x -> FixedAsset) -> Generic FixedAsset
forall x. Rep FixedAsset x -> FixedAsset
forall x. FixedAsset -> Rep FixedAsset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FixedAsset -> Rep FixedAsset x
from :: forall x. FixedAsset -> Rep FixedAsset x
$cto :: forall x. Rep FixedAsset x -> FixedAsset
to :: forall x. Rep FixedAsset x -> FixedAsset
Generic,FixedAsset -> FixedAsset -> Bool
(FixedAsset -> FixedAsset -> Bool)
-> (FixedAsset -> FixedAsset -> Bool) -> Eq FixedAsset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixedAsset -> FixedAsset -> Bool
== :: FixedAsset -> FixedAsset -> Bool
$c/= :: FixedAsset -> FixedAsset -> Bool
/= :: FixedAsset -> FixedAsset -> Bool
Eq,Eq FixedAsset
Eq FixedAsset =>
(FixedAsset -> FixedAsset -> Ordering)
-> (FixedAsset -> FixedAsset -> Bool)
-> (FixedAsset -> FixedAsset -> Bool)
-> (FixedAsset -> FixedAsset -> Bool)
-> (FixedAsset -> FixedAsset -> Bool)
-> (FixedAsset -> FixedAsset -> FixedAsset)
-> (FixedAsset -> FixedAsset -> FixedAsset)
-> Ord FixedAsset
FixedAsset -> FixedAsset -> Bool
FixedAsset -> FixedAsset -> Ordering
FixedAsset -> FixedAsset -> FixedAsset
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 :: FixedAsset -> FixedAsset -> Ordering
compare :: FixedAsset -> FixedAsset -> Ordering
$c< :: FixedAsset -> FixedAsset -> Bool
< :: FixedAsset -> FixedAsset -> Bool
$c<= :: FixedAsset -> FixedAsset -> Bool
<= :: FixedAsset -> FixedAsset -> Bool
$c> :: FixedAsset -> FixedAsset -> Bool
> :: FixedAsset -> FixedAsset -> Bool
$c>= :: FixedAsset -> FixedAsset -> Bool
>= :: FixedAsset -> FixedAsset -> Bool
$cmax :: FixedAsset -> FixedAsset -> FixedAsset
max :: FixedAsset -> FixedAsset -> FixedAsset
$cmin :: FixedAsset -> FixedAsset -> FixedAsset
min :: FixedAsset -> FixedAsset -> FixedAsset
Ord)


-- Base type to hold all asset types
data AssetUnion = MO Mortgage
                | LO Loan
                | IL Installment
                | LS Lease
                | FA FixedAsset
                | RE Receivable
                | PF ProjectedCashflow
                deriving (Int -> AssetUnion -> ShowS
[AssetUnion] -> ShowS
AssetUnion -> [Char]
(Int -> AssetUnion -> ShowS)
-> (AssetUnion -> [Char])
-> ([AssetUnion] -> ShowS)
-> Show AssetUnion
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetUnion -> ShowS
showsPrec :: Int -> AssetUnion -> ShowS
$cshow :: AssetUnion -> [Char]
show :: AssetUnion -> [Char]
$cshowList :: [AssetUnion] -> ShowS
showList :: [AssetUnion] -> ShowS
Show, (forall x. AssetUnion -> Rep AssetUnion x)
-> (forall x. Rep AssetUnion x -> AssetUnion) -> Generic AssetUnion
forall x. Rep AssetUnion x -> AssetUnion
forall x. AssetUnion -> Rep AssetUnion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssetUnion -> Rep AssetUnion x
from :: forall x. AssetUnion -> Rep AssetUnion x
$cto :: forall x. Rep AssetUnion x -> AssetUnion
to :: forall x. Rep AssetUnion x -> AssetUnion
Generic,Eq AssetUnion
Eq AssetUnion =>
(AssetUnion -> AssetUnion -> Ordering)
-> (AssetUnion -> AssetUnion -> Bool)
-> (AssetUnion -> AssetUnion -> Bool)
-> (AssetUnion -> AssetUnion -> Bool)
-> (AssetUnion -> AssetUnion -> Bool)
-> (AssetUnion -> AssetUnion -> AssetUnion)
-> (AssetUnion -> AssetUnion -> AssetUnion)
-> Ord AssetUnion
AssetUnion -> AssetUnion -> Bool
AssetUnion -> AssetUnion -> Ordering
AssetUnion -> AssetUnion -> AssetUnion
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 :: AssetUnion -> AssetUnion -> Ordering
compare :: AssetUnion -> AssetUnion -> Ordering
$c< :: AssetUnion -> AssetUnion -> Bool
< :: AssetUnion -> AssetUnion -> Bool
$c<= :: AssetUnion -> AssetUnion -> Bool
<= :: AssetUnion -> AssetUnion -> Bool
$c> :: AssetUnion -> AssetUnion -> Bool
> :: AssetUnion -> AssetUnion -> Bool
$c>= :: AssetUnion -> AssetUnion -> Bool
>= :: AssetUnion -> AssetUnion -> Bool
$cmax :: AssetUnion -> AssetUnion -> AssetUnion
max :: AssetUnion -> AssetUnion -> AssetUnion
$cmin :: AssetUnion -> AssetUnion -> AssetUnion
min :: AssetUnion -> AssetUnion -> AssetUnion
Ord,AssetUnion -> AssetUnion -> Bool
(AssetUnion -> AssetUnion -> Bool)
-> (AssetUnion -> AssetUnion -> Bool) -> Eq AssetUnion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetUnion -> AssetUnion -> Bool
== :: AssetUnion -> AssetUnion -> Bool
$c/= :: AssetUnion -> AssetUnion -> Bool
/= :: AssetUnion -> AssetUnion -> Bool
Eq)


instance IR.UseRate AssetUnion where
  getIndex :: AssetUnion -> Maybe Index
getIndex (MO Mortgage
ma) = Mortgage -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex Mortgage
ma
  getIndex (LO Loan
ma) = Loan -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex Loan
ma
  getIndex (IL Installment
ma) = Installment -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex Installment
ma
  getIndex (LS Lease
ma) = Lease -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex Lease
ma
  getIndex (FA FixedAsset
ma) = FixedAsset -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex FixedAsset
ma
  getIndex (RE Receivable
ma) = Receivable -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex Receivable
ma
  getIndex (PF ProjectedCashflow
ma) = ProjectedCashflow -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex ProjectedCashflow
ma


instance IR.UseRate Mortgage where 
  getIndex :: Mortgage -> Maybe Index
getIndex (Mortgage oi :: OriginalInfo
oi@MortgageOriginalInfo{ originRate :: OriginalInfo -> RateType
originRate = IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_ } Balance
_ IRate
_ Int
_ Maybe Int
_ Status
_) = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
idx 
  getIndex Mortgage {} = Maybe Index
forall a. Maybe a
Nothing
  getIndex (AdjustRateMortgage oi :: OriginalInfo
oi@MortgageOriginalInfo{ originRate :: OriginalInfo -> RateType
originRate = IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_ } ARM
_ Balance
_ IRate
_ Int
_ Maybe Int
_ Status
_) = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
idx 
  getIndex AdjustRateMortgage {} = Maybe Index
forall a. Maybe a
Nothing

instance IR.UseRate Loan where
  getIndex :: Loan -> Maybe Index
getIndex (PersonalLoan oi :: OriginalInfo
oi@LoanOriginalInfo{originRate :: OriginalInfo -> RateType
originRate = IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_ } Balance
_ IRate
_ Int
_ Status
_) = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
idx 
  getIndex PersonalLoan {} = Maybe Index
forall a. Maybe a
Nothing

instance IR.UseRate Installment where 
  getIndex :: Installment -> Maybe Index
getIndex (Installment oi :: OriginalInfo
oi@LoanOriginalInfo{originRate :: OriginalInfo -> RateType
originRate = IR.Floater DayCount
_ Index
idx IRate
_ IRate
_ DatePattern
_ Maybe IRate
_ Maybe IRate
_ Maybe (RoundingBy IRate)
_ } Balance
_ Int
_ Status
_) = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
idx 
  getIndex Installment {} = Maybe Index
forall a. Maybe a
Nothing
  
instance IR.UseRate Lease where
  getIndex :: Lease -> Maybe Index
  getIndex :: Lease -> Maybe Index
getIndex Lease
_ = Maybe Index
forall a. Maybe a
Nothing

instance IR.UseRate FixedAsset where
  getIndex :: FixedAsset -> Maybe Index
getIndex FixedAsset
_ = Maybe Index
forall a. Maybe a
Nothing

instance IR.UseRate Receivable where
  getIndex :: Receivable -> Maybe Index
getIndex Receivable
_ = Maybe Index
forall a. Maybe a
Nothing

instance IR.UseRate ProjectedCashflow where 
  getIndex :: ProjectedCashflow -> Maybe Index
getIndex (ProjectedFlowFixed CashFlowFrame
cf DatePattern
_) = Maybe Index
forall a. Maybe a
Nothing  

  getIndex (ProjectedFlowMixFloater CashFlowFrame
cf DatePattern
_ FixRatePortion
_ (FloatRatePortion
f:[FloatRatePortion]
fs)) = Index -> Maybe Index
forall a. a -> Maybe a
Just (Index -> Maybe Index) -> Index -> Maybe Index
forall a b. (a -> b) -> a -> b
$ (\(Rate
a,IRate
b,Index
c) -> Index
c) FloatRatePortion
f 
  getIndexes :: ProjectedCashflow -> Maybe [Index]
getIndexes (ProjectedFlowMixFloater CashFlowFrame
cf DatePattern
_ FixRatePortion
_ [FloatRatePortion]
fs ) 
    = [Index] -> Maybe [Index]
forall a. a -> Maybe a
Just ([Index] -> Maybe [Index]) -> [Index] -> Maybe [Index]
forall a b. (a -> b) -> a -> b
$ (\(Rate
a,IRate
b,Index
c) -> Index
c) (FloatRatePortion -> Index) -> [FloatRatePortion] -> [Index]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FloatRatePortion]
fs


$(concat <$> traverse (deriveJSON defaultOptions) [''Obligor, ''OriginalInfo, ''FixedAsset, ''AmortPlan, ''PrepayPenaltyType
    , ''Capacity, ''AmortRule, ''ReceivableFeeType, ''LeaseRateCalc])


makePrisms ''OriginalInfo

$(deriveJSON defaultOptions ''AssociateExp)
$(deriveJSON defaultOptions ''AssociateIncome)
$(deriveJSON defaultOptions ''Status)
$(deriveJSON defaultOptions ''Installment)
$(deriveJSON defaultOptions ''LeaseStepUp)
$(deriveJSON defaultOptions ''Mortgage)
$(deriveJSON defaultOptions ''Loan)
$(deriveJSON defaultOptions ''Lease)
$(deriveJSON defaultOptions ''Receivable)
$(deriveJSON defaultOptions ''ProjectedCashflow)
$(deriveJSON defaultOptions ''AssetUnion)
instance ToSchema Capacity
instance ToSchema AmortRule
instance ToSchema (Ratio Integer) where 
  declareNamedSchema :: Proxy Rate -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Rate
_ = Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema)
-> DeclareT (Definitions Schema) Identity Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Double -> DeclareT (Definitions Schema) Identity Schema
forall a.
ToSchema a =>
Proxy a -> DeclareT (Definitions Schema) Identity Schema
declareSchema (Proxy Double
forall {k} (t :: k). Proxy t
Proxy :: Proxy Double)

instance ToSchema (Decimal) where 
  declareNamedSchema :: Proxy Decimal -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Decimal
_ = Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema)
-> DeclareT (Definitions Schema) Identity Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Double -> DeclareT (Definitions Schema) Identity Schema
forall a.
ToSchema a =>
Proxy a -> DeclareT (Definitions Schema) Identity Schema
declareSchema (Proxy Double
forall {k} (t :: k). Proxy t
Proxy :: Proxy Double)

instance ToSchema PrepayPenaltyType
instance ToSchema (TsPoint Int)
instance ToSchema Ts
instance ToSchema (TsPoint Balance)
instance ToSchema (TsPoint IRate)
instance ToSchema (TsPoint Rational)
instance ToSchema (TsPoint Bool)
instance ToSchema (RoundingBy IRate)
instance ToSchema Obligor
instance ToSchema Index
instance ToSchema DayCount
instance ToSchema Direction
instance ToSchema AmortPlan
instance ToSchema CutoffType
instance ToSchema DatePattern
instance ToSchema IR.RateType
instance ToSchema CF.TsRow
instance ToSchema Period
instance ToSchema IR.ARM
instance ToSchema Status
instance ToSchema ReceivableFeeType
instance ToSchema LeaseRateCalc
instance ToSchema OriginalInfo
instance ToSchema Mortgage