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


module Types
  (DayCount(..),DateType(..)
  ,DatePattern(..)
  ,BondName,BondNames,FeeName,FeeNames,AccName,AccNames,AccountName
  ,Ts(..),TsPoint(..),PoolSource(..)
  ,PerPoint(..),PerCurve(..),getValFromPerCurve
  ,Period(..), Threshold(..)
  ,RangeType(..),CutoffType(..),DealStatus(..)
  ,Balance,Index(..)
  ,Cmp(..),TimeHorizion(..)
  ,Date,Dates,TimeSeries(..),IRate,Amount,Rate,StartDate,EndDate,Lag
  ,Spread,Floor,Cap,Interest,Principal,Cash,Default,Loss,Rental,PrepaymentPenalty
  ,SplitType(..),BookItem(..),BookItems,BalanceSheetReport(..),CashflowReport(..)
  ,Floater,CeName,RateAssumption(..)
  ,PrepaymentRate,DefaultRate,RecoveryRate,RemainTerms,Recovery,Prepayment
  ,Table(..),lookupTable,Direction(..),epocDate,BorrowerNum
  ,Txn(..),TxnComment(..)
  ,RoundingBy(..),DateDirection(..)
  ,BookDirection(..),IRR(..),DealCycle(..),Limit(..),Pre(..)
  ,Liable(..),CumPrepay,CumDefault,CumDelinq,CumPrincipal,CumLoss,CumRecovery,PoolId(..)
  ,DealName,lookupIntervalTable,CutoffFields(..),PriceResult(..)
  ,DueInt,DuePremium, DueIoI,DateVector,DealStats(..)
  ,PricingMethod(..),CustomDataType(..),ResultComponent(..),DealStatType(..)
  ,ActionWhen(..),DealStatFields(..)
  ,getDealStatType,getPriceValue,preHasTrigger
  ,MyRatio,HowToPay(..),BondPricingMethod(..),InvestorAction(..)
  ,_BondTxn ,_InspectBal, _IrrResult
  )
  where

import qualified Data.Text as Text
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Time as Time
import qualified Data.Time.Format as TF
import qualified Data.Map as Map
import qualified Data.List.Split
import Text.Regex.Base
import Text.Regex.PCRE
import GHC.Generics
import Language.Haskell.TH

import Control.Lens hiding (element,Index,Empty)
import Control.Lens.TH

import Text.Read (readMaybe, get)
import Data.Aeson (ToJSON, toJSON, Value(String))
import Data.Ratio (Ratio, numerator, denominator)
import Data.Text (pack)
import Control.DeepSeq (NFData,rnf)

import Data.Scientific (fromRationalRepetend,formatScientific, Scientific,FPFormat(Fixed))

import Data.Aeson hiding (json)
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Fixed hiding (Ratio)
import Data.Decimal
import Data.Ix


import Data.List (intercalate, findIndex, find)
-- import Cashflow (CashFlowFrame)

-- import Web.Hyperbole hiding (All,Fixed)

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



type BondName = String
type BondNames = [String]
type FeeName = String
type FeeNames = [String]
type AccName = String
type AccountName = String
type AccNames = [String]
type CeName = String
type Comment = String

type Date = Time.Day
type Dates = [Time.Day]
type StartDate = Date
type EndDate = Date
type LastIntPayDate = Date

type Balance = Centi
-- type Balance = Decimal
type Amount = Balance
type Principal = Balance
type Valuation = Balance

type Interest = Balance
type Default = Balance
type Loss = Balance
type Cash = Balance
type Recovery = Balance
type Prepayment = Balance
type Rental = Balance
type PrepaymentPenalty = Balance
type CumPrepay = Balance
type CumPrincipal = Balance
type CumDefault = Balance
type CumDelinq = Balance
type CumLoss = Balance
type CumRecovery = Balance
type AccruedInterest = Balance

type PerFace = Micro
type WAL = Balance
type Duration = Micro
type Convexity = Micro
type Yield = Micro
type IRR = Micro

type Rate = Rational  -- general Rate like pool factor
type PrepaymentRate = Rate
type DefaultRate = Rate
type RecoveryRate = Rate

type IRate = Micro    -- Interest Rate Type
type Spread = Micro
type Floor = Micro
type Cap = Micro

type RemainTerms = Int
type BorrowerNum = Int
type Lag = Int


data Index = LPR5Y
            | LPR1Y
            | LIBOR1M
            | LIBOR3M
            | LIBOR6M
            | LIBOR1Y
            | USTSY1Y
            | USTSY2Y
            | USTSY3Y
            | USTSY5Y
            | USTSY7Y
            | USTSY10Y
            | USTSY20Y
            | USTSY30Y
            | USCMT1Y
            | PRIME
            | COFI
            | SOFR1M
            | SOFR3M
            | SOFR6M
            | SOFR1Y
            | EURIBOR1M
            | EURIBOR3M
            | EURIBOR6M
            | EURIBOR12M
            | BBSW
            | IRPH --  The IRPH (Índice de Referencia de Préstamos Hipotecarios) is a reference index used in Spain to fix the interest rate of mortgage loans
            | SONIA 
            -- deriving (Show,Eq,Generic,Ord,Read, Bounded, Enum, Finite, Named, ProtoEnum)
            deriving (Int -> Index -> ShowS
[Index] -> ShowS
Index -> [Char]
(Int -> Index -> ShowS)
-> (Index -> [Char]) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Index -> ShowS
showsPrec :: Int -> Index -> ShowS
$cshow :: Index -> [Char]
show :: Index -> [Char]
$cshowList :: [Index] -> ShowS
showList :: [Index] -> ShowS
Show,Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
/= :: Index -> Index -> Bool
Eq,(forall x. Index -> Rep Index x)
-> (forall x. Rep Index x -> Index) -> Generic Index
forall x. Rep Index x -> Index
forall x. Index -> Rep Index x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Index -> Rep Index x
from :: forall x. Index -> Rep Index x
$cto :: forall x. Rep Index x -> Index
to :: forall x. Rep Index x -> Index
Generic,Eq Index
Eq Index =>
(Index -> Index -> Ordering)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Index)
-> (Index -> Index -> Index)
-> Ord Index
Index -> Index -> Bool
Index -> Index -> Ordering
Index -> Index -> Index
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 :: Index -> Index -> Ordering
compare :: Index -> Index -> Ordering
$c< :: Index -> Index -> Bool
< :: Index -> Index -> Bool
$c<= :: Index -> Index -> Bool
<= :: Index -> Index -> Bool
$c> :: Index -> Index -> Bool
> :: Index -> Index -> Bool
$c>= :: Index -> Index -> Bool
>= :: Index -> Index -> Bool
$cmax :: Index -> Index -> Index
max :: Index -> Index -> Index
$cmin :: Index -> Index -> Index
min :: Index -> Index -> Index
Ord,ReadPrec [Index]
ReadPrec Index
Int -> ReadS Index
ReadS [Index]
(Int -> ReadS Index)
-> ReadS [Index]
-> ReadPrec Index
-> ReadPrec [Index]
-> Read Index
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Index
readsPrec :: Int -> ReadS Index
$creadList :: ReadS [Index]
readList :: ReadS [Index]
$creadPrec :: ReadPrec Index
readPrec :: ReadPrec Index
$creadListPrec :: ReadPrec [Index]
readListPrec :: ReadPrec [Index]
Read)

type Floater = (Index,Spread)

epocDate :: Day
epocDate = Year -> Int -> Int -> Day
Time.fromGregorian Year
1970 Int
1 Int
1
-- http://www.deltaquants.com/day-count-conventions
data DayCount = DC_30E_360       -- ^ ISMA European 30S/360 Special German Eurobond Basis
              | DC_30Ep_360      -- ^ 30E+/360
              | DC_ACT_360       -- ^ Actual/360 , French
              | DC_ACT_365
              | DC_ACT_365A      -- ^ Actual/365 Actual 
              | DC_ACT_365L      -- ^ Actual/365 Leap Year
              | DC_NL_365        -- ^ Actual/365 No leap year
              | DC_ACT_365F      -- ^ Actual /365 Fixed, English
              | DC_ACT_ACT       -- ^ Actual/Actual ISDA 
              | DC_30_360_ISDA   -- ^ IDSA
              | DC_30_360_German -- ^ Gernman
              | DC_30_360_US     -- ^ 30/360 US Municipal , Bond basis
              deriving (Int -> DayCount -> ShowS
[DayCount] -> ShowS
DayCount -> [Char]
(Int -> DayCount -> ShowS)
-> (DayCount -> [Char]) -> ([DayCount] -> ShowS) -> Show DayCount
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DayCount -> ShowS
showsPrec :: Int -> DayCount -> ShowS
$cshow :: DayCount -> [Char]
show :: DayCount -> [Char]
$cshowList :: [DayCount] -> ShowS
showList :: [DayCount] -> ShowS
Show,DayCount -> DayCount -> Bool
(DayCount -> DayCount -> Bool)
-> (DayCount -> DayCount -> Bool) -> Eq DayCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DayCount -> DayCount -> Bool
== :: DayCount -> DayCount -> Bool
$c/= :: DayCount -> DayCount -> Bool
/= :: DayCount -> DayCount -> Bool
Eq,(forall x. DayCount -> Rep DayCount x)
-> (forall x. Rep DayCount x -> DayCount) -> Generic DayCount
forall x. Rep DayCount x -> DayCount
forall x. DayCount -> Rep DayCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DayCount -> Rep DayCount x
from :: forall x. DayCount -> Rep DayCount x
$cto :: forall x. Rep DayCount x -> DayCount
to :: forall x. Rep DayCount x -> DayCount
Generic,Eq DayCount
Eq DayCount =>
(DayCount -> DayCount -> Ordering)
-> (DayCount -> DayCount -> Bool)
-> (DayCount -> DayCount -> Bool)
-> (DayCount -> DayCount -> Bool)
-> (DayCount -> DayCount -> Bool)
-> (DayCount -> DayCount -> DayCount)
-> (DayCount -> DayCount -> DayCount)
-> Ord DayCount
DayCount -> DayCount -> Bool
DayCount -> DayCount -> Ordering
DayCount -> DayCount -> DayCount
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 :: DayCount -> DayCount -> Ordering
compare :: DayCount -> DayCount -> Ordering
$c< :: DayCount -> DayCount -> Bool
< :: DayCount -> DayCount -> Bool
$c<= :: DayCount -> DayCount -> Bool
<= :: DayCount -> DayCount -> Bool
$c> :: DayCount -> DayCount -> Bool
> :: DayCount -> DayCount -> Bool
$c>= :: DayCount -> DayCount -> Bool
>= :: DayCount -> DayCount -> Bool
$cmax :: DayCount -> DayCount -> DayCount
max :: DayCount -> DayCount -> DayCount
$cmin :: DayCount -> DayCount -> DayCount
min :: DayCount -> DayCount -> DayCount
Ord,ReadPrec [DayCount]
ReadPrec DayCount
Int -> ReadS DayCount
ReadS [DayCount]
(Int -> ReadS DayCount)
-> ReadS [DayCount]
-> ReadPrec DayCount
-> ReadPrec [DayCount]
-> Read DayCount
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DayCount
readsPrec :: Int -> ReadS DayCount
$creadList :: ReadS [DayCount]
readList :: ReadS [DayCount]
$creadPrec :: ReadPrec DayCount
readPrec :: ReadPrec DayCount
$creadListPrec :: ReadPrec [DayCount]
readListPrec :: ReadPrec [DayCount]
Read)


data DateType = ClosingDate             -- ^ deal closing day
              | CutoffDate              -- ^ after which, the pool cashflow was aggregated to SPV
              | FirstPayDate            -- ^ first payment day for bond/waterfall to run with
              | NextPayDate
              | NextCollectDate
              | FirstCollectDate        -- ^ first collection day for pool
              | LastCollectDate         -- ^ last collection day for pool
              | LastPayDate            -- ^ last payment day for bond/waterfall 
              | StatedMaturityDate      -- ^ sated maturity date, all cashflow projection/deal action stops by
              | DistributionDates       -- ^ distribution date for waterfall
              | CollectionDates         -- ^ collection date for pool
              | CustomExeDates String   -- ^ custom execution date
              deriving (Int -> DateType -> ShowS
[DateType] -> ShowS
DateType -> [Char]
(Int -> DateType -> ShowS)
-> (DateType -> [Char]) -> ([DateType] -> ShowS) -> Show DateType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateType -> ShowS
showsPrec :: Int -> DateType -> ShowS
$cshow :: DateType -> [Char]
show :: DateType -> [Char]
$cshowList :: [DateType] -> ShowS
showList :: [DateType] -> ShowS
Show,Eq DateType
Eq DateType =>
(DateType -> DateType -> Ordering)
-> (DateType -> DateType -> Bool)
-> (DateType -> DateType -> Bool)
-> (DateType -> DateType -> Bool)
-> (DateType -> DateType -> Bool)
-> (DateType -> DateType -> DateType)
-> (DateType -> DateType -> DateType)
-> Ord DateType
DateType -> DateType -> Bool
DateType -> DateType -> Ordering
DateType -> DateType -> DateType
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 :: DateType -> DateType -> Ordering
compare :: DateType -> DateType -> Ordering
$c< :: DateType -> DateType -> Bool
< :: DateType -> DateType -> Bool
$c<= :: DateType -> DateType -> Bool
<= :: DateType -> DateType -> Bool
$c> :: DateType -> DateType -> Bool
> :: DateType -> DateType -> Bool
$c>= :: DateType -> DateType -> Bool
>= :: DateType -> DateType -> Bool
$cmax :: DateType -> DateType -> DateType
max :: DateType -> DateType -> DateType
$cmin :: DateType -> DateType -> DateType
min :: DateType -> DateType -> DateType
Ord,DateType -> DateType -> Bool
(DateType -> DateType -> Bool)
-> (DateType -> DateType -> Bool) -> Eq DateType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DateType -> DateType -> Bool
== :: DateType -> DateType -> Bool
$c/= :: DateType -> DateType -> Bool
/= :: DateType -> DateType -> Bool
Eq,(forall x. DateType -> Rep DateType x)
-> (forall x. Rep DateType x -> DateType) -> Generic DateType
forall x. Rep DateType x -> DateType
forall x. DateType -> Rep DateType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DateType -> Rep DateType x
from :: forall x. DateType -> Rep DateType x
$cto :: forall x. Rep DateType x -> DateType
to :: forall x. Rep DateType x -> DateType
Generic,ReadPrec [DateType]
ReadPrec DateType
Int -> ReadS DateType
ReadS [DateType]
(Int -> ReadS DateType)
-> ReadS [DateType]
-> ReadPrec DateType
-> ReadPrec [DateType]
-> Read DateType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DateType
readsPrec :: Int -> ReadS DateType
$creadList :: ReadS [DateType]
readList :: ReadS [DateType]
$creadPrec :: ReadPrec DateType
readPrec :: ReadPrec DateType
$creadListPrec :: ReadPrec [DateType]
readListPrec :: ReadPrec [DateType]
Read)


data DatePattern = MonthEnd
                 | QuarterEnd
                 | YearEnd 
                 | MonthFirst
                 | QuarterFirst
                 | MidYear
                 | YearFirst
                 | MonthDayOfYear Int Int  -- T.MonthOfYear T.DayOfMonth
                 | DayOfMonth Int -- T.DayOfMonth 
                 | SemiAnnual (Int, Int) (Int, Int)
                 | CustomDate [Date]
                 | SingletonDate Date
                 | DaysInYear [(Int, Int)] -- MM/DD
                 | EveryNMonth Date Int
                 | Weekday Int 
                 | AllDatePattern [DatePattern]
                 | StartsExclusive Date DatePattern -- TODO depricated
                 | StartsAt CutoffType Date DatePattern
                 | EndsAt CutoffType Date DatePattern
                 | Exclude DatePattern [DatePattern]
                 | OffsetBy DatePattern Int
                 -- | DayOfWeek Int -- T.DayOfWeek
                 deriving (Int -> DatePattern -> ShowS
[DatePattern] -> ShowS
DatePattern -> [Char]
(Int -> DatePattern -> ShowS)
-> (DatePattern -> [Char])
-> ([DatePattern] -> ShowS)
-> Show DatePattern
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatePattern -> ShowS
showsPrec :: Int -> DatePattern -> ShowS
$cshow :: DatePattern -> [Char]
show :: DatePattern -> [Char]
$cshowList :: [DatePattern] -> ShowS
showList :: [DatePattern] -> ShowS
Show, DatePattern -> DatePattern -> Bool
(DatePattern -> DatePattern -> Bool)
-> (DatePattern -> DatePattern -> Bool) -> Eq DatePattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatePattern -> DatePattern -> Bool
== :: DatePattern -> DatePattern -> Bool
$c/= :: DatePattern -> DatePattern -> Bool
/= :: DatePattern -> DatePattern -> Bool
Eq, (forall x. DatePattern -> Rep DatePattern x)
-> (forall x. Rep DatePattern x -> DatePattern)
-> Generic DatePattern
forall x. Rep DatePattern x -> DatePattern
forall x. DatePattern -> Rep DatePattern x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DatePattern -> Rep DatePattern x
from :: forall x. DatePattern -> Rep DatePattern x
$cto :: forall x. Rep DatePattern x -> DatePattern
to :: forall x. Rep DatePattern x -> DatePattern
Generic, Eq DatePattern
Eq DatePattern =>
(DatePattern -> DatePattern -> Ordering)
-> (DatePattern -> DatePattern -> Bool)
-> (DatePattern -> DatePattern -> Bool)
-> (DatePattern -> DatePattern -> Bool)
-> (DatePattern -> DatePattern -> Bool)
-> (DatePattern -> DatePattern -> DatePattern)
-> (DatePattern -> DatePattern -> DatePattern)
-> Ord DatePattern
DatePattern -> DatePattern -> Bool
DatePattern -> DatePattern -> Ordering
DatePattern -> DatePattern -> DatePattern
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 :: DatePattern -> DatePattern -> Ordering
compare :: DatePattern -> DatePattern -> Ordering
$c< :: DatePattern -> DatePattern -> Bool
< :: DatePattern -> DatePattern -> Bool
$c<= :: DatePattern -> DatePattern -> Bool
<= :: DatePattern -> DatePattern -> Bool
$c> :: DatePattern -> DatePattern -> Bool
> :: DatePattern -> DatePattern -> Bool
$c>= :: DatePattern -> DatePattern -> Bool
>= :: DatePattern -> DatePattern -> Bool
$cmax :: DatePattern -> DatePattern -> DatePattern
max :: DatePattern -> DatePattern -> DatePattern
$cmin :: DatePattern -> DatePattern -> DatePattern
min :: DatePattern -> DatePattern -> DatePattern
Ord, ReadPrec [DatePattern]
ReadPrec DatePattern
Int -> ReadS DatePattern
ReadS [DatePattern]
(Int -> ReadS DatePattern)
-> ReadS [DatePattern]
-> ReadPrec DatePattern
-> ReadPrec [DatePattern]
-> Read DatePattern
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DatePattern
readsPrec :: Int -> ReadS DatePattern
$creadList :: ReadS [DatePattern]
readList :: ReadS [DatePattern]
$creadPrec :: ReadPrec DatePattern
readPrec :: ReadPrec DatePattern
$creadListPrec :: ReadPrec [DatePattern]
readListPrec :: ReadPrec [DatePattern]
Read)


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

type DateVector = (Date, DatePattern)

data RoundingBy a = RoundCeil a 
                  | RoundFloor a
                  deriving (Int -> RoundingBy a -> ShowS
[RoundingBy a] -> ShowS
RoundingBy a -> [Char]
(Int -> RoundingBy a -> ShowS)
-> (RoundingBy a -> [Char])
-> ([RoundingBy a] -> ShowS)
-> Show (RoundingBy a)
forall a. Show a => Int -> RoundingBy a -> ShowS
forall a. Show a => [RoundingBy a] -> ShowS
forall a. Show a => RoundingBy a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RoundingBy a -> ShowS
showsPrec :: Int -> RoundingBy a -> ShowS
$cshow :: forall a. Show a => RoundingBy a -> [Char]
show :: RoundingBy a -> [Char]
$cshowList :: forall a. Show a => [RoundingBy a] -> ShowS
showList :: [RoundingBy a] -> ShowS
Show, (forall x. RoundingBy a -> Rep (RoundingBy a) x)
-> (forall x. Rep (RoundingBy a) x -> RoundingBy a)
-> Generic (RoundingBy a)
forall x. Rep (RoundingBy a) x -> RoundingBy a
forall x. RoundingBy a -> Rep (RoundingBy a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RoundingBy a) x -> RoundingBy a
forall a x. RoundingBy a -> Rep (RoundingBy a) x
$cfrom :: forall a x. RoundingBy a -> Rep (RoundingBy a) x
from :: forall x. RoundingBy a -> Rep (RoundingBy a) x
$cto :: forall a x. Rep (RoundingBy a) x -> RoundingBy a
to :: forall x. Rep (RoundingBy a) x -> RoundingBy a
Generic, RoundingBy a -> RoundingBy a -> Bool
(RoundingBy a -> RoundingBy a -> Bool)
-> (RoundingBy a -> RoundingBy a -> Bool) -> Eq (RoundingBy a)
forall a. Eq a => RoundingBy a -> RoundingBy a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RoundingBy a -> RoundingBy a -> Bool
== :: RoundingBy a -> RoundingBy a -> Bool
$c/= :: forall a. Eq a => RoundingBy a -> RoundingBy a -> Bool
/= :: RoundingBy a -> RoundingBy a -> Bool
Eq, Eq (RoundingBy a)
Eq (RoundingBy a) =>
(RoundingBy a -> RoundingBy a -> Ordering)
-> (RoundingBy a -> RoundingBy a -> Bool)
-> (RoundingBy a -> RoundingBy a -> Bool)
-> (RoundingBy a -> RoundingBy a -> Bool)
-> (RoundingBy a -> RoundingBy a -> Bool)
-> (RoundingBy a -> RoundingBy a -> RoundingBy a)
-> (RoundingBy a -> RoundingBy a -> RoundingBy a)
-> Ord (RoundingBy a)
RoundingBy a -> RoundingBy a -> Bool
RoundingBy a -> RoundingBy a -> Ordering
RoundingBy a -> RoundingBy a -> RoundingBy a
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
forall a. Ord a => Eq (RoundingBy a)
forall a. Ord a => RoundingBy a -> RoundingBy a -> Bool
forall a. Ord a => RoundingBy a -> RoundingBy a -> Ordering
forall a. Ord a => RoundingBy a -> RoundingBy a -> RoundingBy a
$ccompare :: forall a. Ord a => RoundingBy a -> RoundingBy a -> Ordering
compare :: RoundingBy a -> RoundingBy a -> Ordering
$c< :: forall a. Ord a => RoundingBy a -> RoundingBy a -> Bool
< :: RoundingBy a -> RoundingBy a -> Bool
$c<= :: forall a. Ord a => RoundingBy a -> RoundingBy a -> Bool
<= :: RoundingBy a -> RoundingBy a -> Bool
$c> :: forall a. Ord a => RoundingBy a -> RoundingBy a -> Bool
> :: RoundingBy a -> RoundingBy a -> Bool
$c>= :: forall a. Ord a => RoundingBy a -> RoundingBy a -> Bool
>= :: RoundingBy a -> RoundingBy a -> Bool
$cmax :: forall a. Ord a => RoundingBy a -> RoundingBy a -> RoundingBy a
max :: RoundingBy a -> RoundingBy a -> RoundingBy a
$cmin :: forall a. Ord a => RoundingBy a -> RoundingBy a -> RoundingBy a
min :: RoundingBy a -> RoundingBy a -> RoundingBy a
Ord, ReadPrec [RoundingBy a]
ReadPrec (RoundingBy a)
Int -> ReadS (RoundingBy a)
ReadS [RoundingBy a]
(Int -> ReadS (RoundingBy a))
-> ReadS [RoundingBy a]
-> ReadPrec (RoundingBy a)
-> ReadPrec [RoundingBy a]
-> Read (RoundingBy a)
forall a. Read a => ReadPrec [RoundingBy a]
forall a. Read a => ReadPrec (RoundingBy a)
forall a. Read a => Int -> ReadS (RoundingBy a)
forall a. Read a => ReadS [RoundingBy a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (RoundingBy a)
readsPrec :: Int -> ReadS (RoundingBy a)
$creadList :: forall a. Read a => ReadS [RoundingBy a]
readList :: ReadS [RoundingBy a]
$creadPrec :: forall a. Read a => ReadPrec (RoundingBy a)
readPrec :: ReadPrec (RoundingBy a)
$creadListPrec :: forall a. Read a => ReadPrec [RoundingBy a]
readListPrec :: ReadPrec [RoundingBy a]
Read)

type DealName = String

data PoolId = PoolName String                         -- ^ pool name
            | PoolConsol                              -- ^ consolidate pool ( the only pool )
            | DealBondFlow DealName String Date Rate  -- ^ bond flow from deal
            deriving (PoolId -> PoolId -> Bool
(PoolId -> PoolId -> Bool)
-> (PoolId -> PoolId -> Bool) -> Eq PoolId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoolId -> PoolId -> Bool
== :: PoolId -> PoolId -> Bool
$c/= :: PoolId -> PoolId -> Bool
/= :: PoolId -> PoolId -> Bool
Eq,Eq PoolId
Eq PoolId =>
(PoolId -> PoolId -> Ordering)
-> (PoolId -> PoolId -> Bool)
-> (PoolId -> PoolId -> Bool)
-> (PoolId -> PoolId -> Bool)
-> (PoolId -> PoolId -> Bool)
-> (PoolId -> PoolId -> PoolId)
-> (PoolId -> PoolId -> PoolId)
-> Ord PoolId
PoolId -> PoolId -> Bool
PoolId -> PoolId -> Ordering
PoolId -> PoolId -> PoolId
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 :: PoolId -> PoolId -> Ordering
compare :: PoolId -> PoolId -> Ordering
$c< :: PoolId -> PoolId -> Bool
< :: PoolId -> PoolId -> Bool
$c<= :: PoolId -> PoolId -> Bool
<= :: PoolId -> PoolId -> Bool
$c> :: PoolId -> PoolId -> Bool
> :: PoolId -> PoolId -> Bool
$c>= :: PoolId -> PoolId -> Bool
>= :: PoolId -> PoolId -> Bool
$cmax :: PoolId -> PoolId -> PoolId
max :: PoolId -> PoolId -> PoolId
$cmin :: PoolId -> PoolId -> PoolId
min :: PoolId -> PoolId -> PoolId
Ord,(forall x. PoolId -> Rep PoolId x)
-> (forall x. Rep PoolId x -> PoolId) -> Generic PoolId
forall x. Rep PoolId x -> PoolId
forall x. PoolId -> Rep PoolId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PoolId -> Rep PoolId x
from :: forall x. PoolId -> Rep PoolId x
$cto :: forall x. Rep PoolId x -> PoolId
to :: forall x. Rep PoolId x -> PoolId
Generic)

instance Show PoolId where
  show :: PoolId -> [Char]
show (PoolName [Char]
n)  = [Char]
n
  show PoolId
PoolConsol = [Char]
"PoolConsol"
  show (DealBondFlow [Char]
dn [Char]
bn Day
sd Rate
r) = [Char]
"BondFlow:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
dn[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
":"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
bn[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
":"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Day -> [Char]
forall a. Show a => a -> [Char]
show Day
sd[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
":"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Rate -> [Char]
forall a. Show a => a -> [Char]
show Rate
r

instance (Read PoolId) where
  readsPrec :: Int -> ReadS PoolId
readsPrec Int
d [Char]
"PoolConsol" = [(PoolId
PoolConsol,[Char]
"")]
  readsPrec Int
d [Char]
rStr = 
    let 
      pn :: [[Char]]
pn = [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
Data.List.Split.splitOn [Char]
":" [Char]
rStr
    in
      case [[Char]]
pn of
        [[Char]
dn,[Char]
bn,[Char]
sd,[Char]
r] -> 
          let 
            sd' :: Day
sd' = Bool -> TimeLocale -> [Char] -> [Char] -> Day
forall t.
ParseTime t =>
Bool -> TimeLocale -> [Char] -> [Char] -> t
TF.parseTimeOrError Bool
True TimeLocale
TF.defaultTimeLocale [Char]
"%Y-%m-%d" [Char]
sd
            r' :: Rate
r' = [Char] -> Rate
forall a. Read a => [Char] -> a
read [Char]
r::Rate
          in 
            [([Char] -> [Char] -> Day -> Rate -> PoolId
DealBondFlow [Char]
dn [Char]
bn Day
sd' Rate
r',[Char]
"")]
        [[Char]
"PoolName",[Char]
pn] -> [([Char] -> PoolId
PoolName [Char]
pn,[Char]
"")]
        [[Char]]
_ -> ReadS PoolId
forall a. HasCallStack => [Char] -> a
error ReadS PoolId -> ReadS PoolId
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid PoolId: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
pn




data Cmp = G      -- ^ Greater than 
         | GE     -- ^ Greater Equal than
         | L      -- ^ Less than
         | LE     -- ^ Less Equal than
         | E      -- ^ Equals to
         deriving ((forall x. Cmp -> Rep Cmp x)
-> (forall x. Rep Cmp x -> Cmp) -> Generic Cmp
forall x. Rep Cmp x -> Cmp
forall x. Cmp -> Rep Cmp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cmp -> Rep Cmp x
from :: forall x. Cmp -> Rep Cmp x
$cto :: forall x. Rep Cmp x -> Cmp
to :: forall x. Rep Cmp x -> Cmp
Generic,Cmp -> Cmp -> Bool
(Cmp -> Cmp -> Bool) -> (Cmp -> Cmp -> Bool) -> Eq Cmp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cmp -> Cmp -> Bool
== :: Cmp -> Cmp -> Bool
$c/= :: Cmp -> Cmp -> Bool
/= :: Cmp -> Cmp -> Bool
Eq,Eq Cmp
Eq Cmp =>
(Cmp -> Cmp -> Ordering)
-> (Cmp -> Cmp -> Bool)
-> (Cmp -> Cmp -> Bool)
-> (Cmp -> Cmp -> Bool)
-> (Cmp -> Cmp -> Bool)
-> (Cmp -> Cmp -> Cmp)
-> (Cmp -> Cmp -> Cmp)
-> Ord Cmp
Cmp -> Cmp -> Bool
Cmp -> Cmp -> Ordering
Cmp -> Cmp -> Cmp
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 :: Cmp -> Cmp -> Ordering
compare :: Cmp -> Cmp -> Ordering
$c< :: Cmp -> Cmp -> Bool
< :: Cmp -> Cmp -> Bool
$c<= :: Cmp -> Cmp -> Bool
<= :: Cmp -> Cmp -> Bool
$c> :: Cmp -> Cmp -> Bool
> :: Cmp -> Cmp -> Bool
$c>= :: Cmp -> Cmp -> Bool
>= :: Cmp -> Cmp -> Bool
$cmax :: Cmp -> Cmp -> Cmp
max :: Cmp -> Cmp -> Cmp
$cmin :: Cmp -> Cmp -> Cmp
min :: Cmp -> Cmp -> Cmp
Ord,ReadPrec [Cmp]
ReadPrec Cmp
Int -> ReadS Cmp
ReadS [Cmp]
(Int -> ReadS Cmp)
-> ReadS [Cmp] -> ReadPrec Cmp -> ReadPrec [Cmp] -> Read Cmp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Cmp
readsPrec :: Int -> ReadS Cmp
$creadList :: ReadS [Cmp]
readList :: ReadS [Cmp]
$creadPrec :: ReadPrec Cmp
readPrec :: ReadPrec Cmp
$creadListPrec :: ReadPrec [Cmp]
readListPrec :: ReadPrec [Cmp]
Read)

instance Show Cmp where
  show :: Cmp -> String
  show :: Cmp -> [Char]
show Cmp
G  = [Char]
">"
  show Cmp
GE = [Char]
">="
  show Cmp
L  = [Char]
"<"
  show Cmp
LE = [Char]
"<="
  show Cmp
E  = [Char]
"=="


data PoolSource = CollectedInterest               -- ^ interest
                | CollectedPrincipal              -- ^ schdule principal
                | CollectedRecoveries             -- ^ recoveries 
                | CollectedPrepayment             -- ^ prepayment
                | CollectedPrepaymentPenalty      -- ^ prepayment pentalty
                | CollectedRental                 -- ^ rental from pool
                | CollectedFeePaid                -- ^ fee from pool
                | CollectedCash                   -- ^ cash from pool
                | NewDefaults                     -- ^ new defaults in balance
                | NewLosses                       -- ^ new losses in balance
                | NewDelinquencies                -- ^ new delinquencies in balance
                | CurBalance                      -- ^ performing balance
                | CurBegBalance                   -- ^ performing balance at the beginning of the period
                deriving (Int -> PoolSource -> ShowS
[PoolSource] -> ShowS
PoolSource -> [Char]
(Int -> PoolSource -> ShowS)
-> (PoolSource -> [Char])
-> ([PoolSource] -> ShowS)
-> Show PoolSource
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PoolSource -> ShowS
showsPrec :: Int -> PoolSource -> ShowS
$cshow :: PoolSource -> [Char]
show :: PoolSource -> [Char]
$cshowList :: [PoolSource] -> ShowS
showList :: [PoolSource] -> ShowS
Show,Eq PoolSource
Eq PoolSource =>
(PoolSource -> PoolSource -> Ordering)
-> (PoolSource -> PoolSource -> Bool)
-> (PoolSource -> PoolSource -> Bool)
-> (PoolSource -> PoolSource -> Bool)
-> (PoolSource -> PoolSource -> Bool)
-> (PoolSource -> PoolSource -> PoolSource)
-> (PoolSource -> PoolSource -> PoolSource)
-> Ord PoolSource
PoolSource -> PoolSource -> Bool
PoolSource -> PoolSource -> Ordering
PoolSource -> PoolSource -> PoolSource
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 :: PoolSource -> PoolSource -> Ordering
compare :: PoolSource -> PoolSource -> Ordering
$c< :: PoolSource -> PoolSource -> Bool
< :: PoolSource -> PoolSource -> Bool
$c<= :: PoolSource -> PoolSource -> Bool
<= :: PoolSource -> PoolSource -> Bool
$c> :: PoolSource -> PoolSource -> Bool
> :: PoolSource -> PoolSource -> Bool
$c>= :: PoolSource -> PoolSource -> Bool
>= :: PoolSource -> PoolSource -> Bool
$cmax :: PoolSource -> PoolSource -> PoolSource
max :: PoolSource -> PoolSource -> PoolSource
$cmin :: PoolSource -> PoolSource -> PoolSource
min :: PoolSource -> PoolSource -> PoolSource
Ord,ReadPrec [PoolSource]
ReadPrec PoolSource
Int -> ReadS PoolSource
ReadS [PoolSource]
(Int -> ReadS PoolSource)
-> ReadS [PoolSource]
-> ReadPrec PoolSource
-> ReadPrec [PoolSource]
-> Read PoolSource
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PoolSource
readsPrec :: Int -> ReadS PoolSource
$creadList :: ReadS [PoolSource]
readList :: ReadS [PoolSource]
$creadPrec :: ReadPrec PoolSource
readPrec :: ReadPrec PoolSource
$creadListPrec :: ReadPrec [PoolSource]
readListPrec :: ReadPrec [PoolSource]
Read,PoolSource -> PoolSource -> Bool
(PoolSource -> PoolSource -> Bool)
-> (PoolSource -> PoolSource -> Bool) -> Eq PoolSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoolSource -> PoolSource -> Bool
== :: PoolSource -> PoolSource -> Bool
$c/= :: PoolSource -> PoolSource -> Bool
/= :: PoolSource -> PoolSource -> Bool
Eq, (forall x. PoolSource -> Rep PoolSource x)
-> (forall x. Rep PoolSource x -> PoolSource) -> Generic PoolSource
forall x. Rep PoolSource x -> PoolSource
forall x. PoolSource -> Rep PoolSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PoolSource -> Rep PoolSource x
from :: forall x. PoolSource -> Rep PoolSource x
$cto :: forall x. Rep PoolSource x -> PoolSource
to :: forall x. Rep PoolSource x -> PoolSource
Generic)


data TsPoint a = TsPoint Date a
                deriving (Int -> TsPoint a -> ShowS
[TsPoint a] -> ShowS
TsPoint a -> [Char]
(Int -> TsPoint a -> ShowS)
-> (TsPoint a -> [Char])
-> ([TsPoint a] -> ShowS)
-> Show (TsPoint a)
forall a. Show a => Int -> TsPoint a -> ShowS
forall a. Show a => [TsPoint a] -> ShowS
forall a. Show a => TsPoint a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TsPoint a -> ShowS
showsPrec :: Int -> TsPoint a -> ShowS
$cshow :: forall a. Show a => TsPoint a -> [Char]
show :: TsPoint a -> [Char]
$cshowList :: forall a. Show a => [TsPoint a] -> ShowS
showList :: [TsPoint a] -> ShowS
Show,TsPoint a -> TsPoint a -> Bool
(TsPoint a -> TsPoint a -> Bool)
-> (TsPoint a -> TsPoint a -> Bool) -> Eq (TsPoint a)
forall a. Eq a => TsPoint a -> TsPoint a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TsPoint a -> TsPoint a -> Bool
== :: TsPoint a -> TsPoint a -> Bool
$c/= :: forall a. Eq a => TsPoint a -> TsPoint a -> Bool
/= :: TsPoint a -> TsPoint a -> Bool
Eq,ReadPrec [TsPoint a]
ReadPrec (TsPoint a)
Int -> ReadS (TsPoint a)
ReadS [TsPoint a]
(Int -> ReadS (TsPoint a))
-> ReadS [TsPoint a]
-> ReadPrec (TsPoint a)
-> ReadPrec [TsPoint a]
-> Read (TsPoint a)
forall a. Read a => ReadPrec [TsPoint a]
forall a. Read a => ReadPrec (TsPoint a)
forall a. Read a => Int -> ReadS (TsPoint a)
forall a. Read a => ReadS [TsPoint a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (TsPoint a)
readsPrec :: Int -> ReadS (TsPoint a)
$creadList :: forall a. Read a => ReadS [TsPoint a]
readList :: ReadS [TsPoint a]
$creadPrec :: forall a. Read a => ReadPrec (TsPoint a)
readPrec :: ReadPrec (TsPoint a)
$creadListPrec :: forall a. Read a => ReadPrec [TsPoint a]
readListPrec :: ReadPrec [TsPoint a]
Read,(forall x. TsPoint a -> Rep (TsPoint a) x)
-> (forall x. Rep (TsPoint a) x -> TsPoint a)
-> Generic (TsPoint a)
forall x. Rep (TsPoint a) x -> TsPoint a
forall x. TsPoint a -> Rep (TsPoint a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TsPoint a) x -> TsPoint a
forall a x. TsPoint a -> Rep (TsPoint a) x
$cfrom :: forall a x. TsPoint a -> Rep (TsPoint a) x
from :: forall x. TsPoint a -> Rep (TsPoint a) x
$cto :: forall a x. Rep (TsPoint a) x -> TsPoint a
to :: forall x. Rep (TsPoint a) x -> TsPoint a
Generic)

instance Ord a => Ord (TsPoint a) where
  compare :: TsPoint a -> TsPoint a -> Ordering
compare (TsPoint Day
d1 a
tv1) (TsPoint Day
d2 a
tv2) = Day -> Day -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Day
d1 Day
d2

data PerPoint a = PerPoint Int a
                deriving (Int -> PerPoint a -> ShowS
[PerPoint a] -> ShowS
PerPoint a -> [Char]
(Int -> PerPoint a -> ShowS)
-> (PerPoint a -> [Char])
-> ([PerPoint a] -> ShowS)
-> Show (PerPoint a)
forall a. Show a => Int -> PerPoint a -> ShowS
forall a. Show a => [PerPoint a] -> ShowS
forall a. Show a => PerPoint a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PerPoint a -> ShowS
showsPrec :: Int -> PerPoint a -> ShowS
$cshow :: forall a. Show a => PerPoint a -> [Char]
show :: PerPoint a -> [Char]
$cshowList :: forall a. Show a => [PerPoint a] -> ShowS
showList :: [PerPoint a] -> ShowS
Show,PerPoint a -> PerPoint a -> Bool
(PerPoint a -> PerPoint a -> Bool)
-> (PerPoint a -> PerPoint a -> Bool) -> Eq (PerPoint a)
forall a. Eq a => PerPoint a -> PerPoint a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PerPoint a -> PerPoint a -> Bool
== :: PerPoint a -> PerPoint a -> Bool
$c/= :: forall a. Eq a => PerPoint a -> PerPoint a -> Bool
/= :: PerPoint a -> PerPoint a -> Bool
Eq,ReadPrec [PerPoint a]
ReadPrec (PerPoint a)
Int -> ReadS (PerPoint a)
ReadS [PerPoint a]
(Int -> ReadS (PerPoint a))
-> ReadS [PerPoint a]
-> ReadPrec (PerPoint a)
-> ReadPrec [PerPoint a]
-> Read (PerPoint a)
forall a. Read a => ReadPrec [PerPoint a]
forall a. Read a => ReadPrec (PerPoint a)
forall a. Read a => Int -> ReadS (PerPoint a)
forall a. Read a => ReadS [PerPoint a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (PerPoint a)
readsPrec :: Int -> ReadS (PerPoint a)
$creadList :: forall a. Read a => ReadS [PerPoint a]
readList :: ReadS [PerPoint a]
$creadPrec :: forall a. Read a => ReadPrec (PerPoint a)
readPrec :: ReadPrec (PerPoint a)
$creadListPrec :: forall a. Read a => ReadPrec [PerPoint a]
readListPrec :: ReadPrec [PerPoint a]
Read,(forall x. PerPoint a -> Rep (PerPoint a) x)
-> (forall x. Rep (PerPoint a) x -> PerPoint a)
-> Generic (PerPoint a)
forall x. Rep (PerPoint a) x -> PerPoint a
forall x. PerPoint a -> Rep (PerPoint a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PerPoint a) x -> PerPoint a
forall a x. PerPoint a -> Rep (PerPoint a) x
$cfrom :: forall a x. PerPoint a -> Rep (PerPoint a) x
from :: forall x. PerPoint a -> Rep (PerPoint a) x
$cto :: forall a x. Rep (PerPoint a) x -> PerPoint a
to :: forall x. Rep (PerPoint a) x -> PerPoint a
Generic)

data PerCurve a = CurrentVal [PerPoint a]
                | WithTrailVal [PerPoint a]
                deriving (Int -> PerCurve a -> ShowS
[PerCurve a] -> ShowS
PerCurve a -> [Char]
(Int -> PerCurve a -> ShowS)
-> (PerCurve a -> [Char])
-> ([PerCurve a] -> ShowS)
-> Show (PerCurve a)
forall a. Show a => Int -> PerCurve a -> ShowS
forall a. Show a => [PerCurve a] -> ShowS
forall a. Show a => PerCurve a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PerCurve a -> ShowS
showsPrec :: Int -> PerCurve a -> ShowS
$cshow :: forall a. Show a => PerCurve a -> [Char]
show :: PerCurve a -> [Char]
$cshowList :: forall a. Show a => [PerCurve a] -> ShowS
showList :: [PerCurve a] -> ShowS
Show,PerCurve a -> PerCurve a -> Bool
(PerCurve a -> PerCurve a -> Bool)
-> (PerCurve a -> PerCurve a -> Bool) -> Eq (PerCurve a)
forall a. Eq a => PerCurve a -> PerCurve a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PerCurve a -> PerCurve a -> Bool
== :: PerCurve a -> PerCurve a -> Bool
$c/= :: forall a. Eq a => PerCurve a -> PerCurve a -> Bool
/= :: PerCurve a -> PerCurve a -> Bool
Eq,ReadPrec [PerCurve a]
ReadPrec (PerCurve a)
Int -> ReadS (PerCurve a)
ReadS [PerCurve a]
(Int -> ReadS (PerCurve a))
-> ReadS [PerCurve a]
-> ReadPrec (PerCurve a)
-> ReadPrec [PerCurve a]
-> Read (PerCurve a)
forall a. Read a => ReadPrec [PerCurve a]
forall a. Read a => ReadPrec (PerCurve a)
forall a. Read a => Int -> ReadS (PerCurve a)
forall a. Read a => ReadS [PerCurve a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (PerCurve a)
readsPrec :: Int -> ReadS (PerCurve a)
$creadList :: forall a. Read a => ReadS [PerCurve a]
readList :: ReadS [PerCurve a]
$creadPrec :: forall a. Read a => ReadPrec (PerCurve a)
readPrec :: ReadPrec (PerCurve a)
$creadListPrec :: forall a. Read a => ReadPrec [PerCurve a]
readListPrec :: ReadPrec [PerCurve a]
Read,(forall x. PerCurve a -> Rep (PerCurve a) x)
-> (forall x. Rep (PerCurve a) x -> PerCurve a)
-> Generic (PerCurve a)
forall x. Rep (PerCurve a) x -> PerCurve a
forall x. PerCurve a -> Rep (PerCurve a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PerCurve a) x -> PerCurve a
forall a x. PerCurve a -> Rep (PerCurve a) x
$cfrom :: forall a x. PerCurve a -> Rep (PerCurve a) x
from :: forall x. PerCurve a -> Rep (PerCurve a) x
$cto :: forall a x. Rep (PerCurve a) x -> PerCurve a
to :: forall x. Rep (PerCurve a) x -> PerCurve a
Generic,Eq (PerCurve a)
Eq (PerCurve a) =>
(PerCurve a -> PerCurve a -> Ordering)
-> (PerCurve a -> PerCurve a -> Bool)
-> (PerCurve a -> PerCurve a -> Bool)
-> (PerCurve a -> PerCurve a -> Bool)
-> (PerCurve a -> PerCurve a -> Bool)
-> (PerCurve a -> PerCurve a -> PerCurve a)
-> (PerCurve a -> PerCurve a -> PerCurve a)
-> Ord (PerCurve a)
PerCurve a -> PerCurve a -> Bool
PerCurve a -> PerCurve a -> Ordering
PerCurve a -> PerCurve a -> PerCurve a
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
forall a. Ord a => Eq (PerCurve a)
forall a. Ord a => PerCurve a -> PerCurve a -> Bool
forall a. Ord a => PerCurve a -> PerCurve a -> Ordering
forall a. Ord a => PerCurve a -> PerCurve a -> PerCurve a
$ccompare :: forall a. Ord a => PerCurve a -> PerCurve a -> Ordering
compare :: PerCurve a -> PerCurve a -> Ordering
$c< :: forall a. Ord a => PerCurve a -> PerCurve a -> Bool
< :: PerCurve a -> PerCurve a -> Bool
$c<= :: forall a. Ord a => PerCurve a -> PerCurve a -> Bool
<= :: PerCurve a -> PerCurve a -> Bool
$c> :: forall a. Ord a => PerCurve a -> PerCurve a -> Bool
> :: PerCurve a -> PerCurve a -> Bool
$c>= :: forall a. Ord a => PerCurve a -> PerCurve a -> Bool
>= :: PerCurve a -> PerCurve a -> Bool
$cmax :: forall a. Ord a => PerCurve a -> PerCurve a -> PerCurve a
max :: PerCurve a -> PerCurve a -> PerCurve a
$cmin :: forall a. Ord a => PerCurve a -> PerCurve a -> PerCurve a
min :: PerCurve a -> PerCurve a -> PerCurve a
Ord)

getValFromPerCurve :: PerCurve a -> DateDirection -> CutoffType -> Int -> Maybe a
getValFromPerCurve :: forall a.
PerCurve a -> DateDirection -> CutoffType -> Int -> Maybe a
getValFromPerCurve (WithTrailVal []) DateDirection
_ CutoffType
_ Int
_ = Maybe a
forall a. Maybe a
Nothing 
getValFromPerCurve (CurrentVal []) DateDirection
_ CutoffType
_ Int
_ = Maybe a
forall a. Maybe a
Nothing 
getValFromPerCurve (CurrentVal (PerPoint a
v:[PerPoint a]
vs)) DateDirection
Future CutoffType
p Int
i 
  = let 
      cmp :: Int -> Int -> Bool
cmp = case CutoffType
p of
              CutoffType
Inc -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
              CutoffType
Exc -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    in
      if Int -> Int -> Bool
cmp (PerPoint a -> Int
forall a. PerPoint a -> Int
getIdxFromPerPoint PerPoint a
v) Int
i then 
        a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ PerPoint a -> a
forall a. PerPoint a -> a
getValFromPerPoint PerPoint a
v
      else 
        PerCurve a -> DateDirection -> CutoffType -> Int -> Maybe a
forall a.
PerCurve a -> DateDirection -> CutoffType -> Int -> Maybe a
getValFromPerCurve ([PerPoint a] -> PerCurve a
forall a. [PerPoint a] -> PerCurve a
CurrentVal [PerPoint a]
vs) DateDirection
Future CutoffType
p Int
i

getValFromPerCurve (CurrentVal [PerPoint a]
vs) DateDirection
Past CutoffType
p Int
i
  = let 
      cmp :: Int -> Int -> Bool
cmp = case CutoffType
p of
              CutoffType
Inc -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
              CutoffType
Exc -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)
      ps :: [PerPoint a]
ps = [PerPoint a] -> [PerPoint a]
forall a. [a] -> [a]
reverse [PerPoint a]
vs
    in
      case (PerPoint a -> Bool) -> [PerPoint a] -> Maybe (PerPoint a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PerPoint a
x -> Int -> Int -> Bool
cmp (PerPoint a -> Int
forall a. PerPoint a -> Int
getIdxFromPerPoint PerPoint a
x) Int
i) [PerPoint a]
ps of
        Just PerPoint a
rs -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ PerPoint a -> a
forall a. PerPoint a -> a
getValFromPerPoint PerPoint a
rs
        Maybe (PerPoint a)
Nothing -> Maybe a
forall a. Maybe a
Nothing


getValFromPerCurve (WithTrailVal [PerPoint a]
_ps) DateDirection
dr CutoffType
p Int
i 
  = let 
      ps :: [PerPoint a]
ps = case DateDirection
dr of 
            DateDirection
Future -> [PerPoint a]
_ps
            DateDirection
Past -> [PerPoint a] -> [PerPoint a]
forall a. [a] -> [a]
reverse [PerPoint a]
_ps
      cmp :: Int -> Int -> Bool
cmp = case CutoffType
p of 
              CutoffType
Inc -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
              CutoffType
Exc -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    in 
      case (PerPoint a -> Bool) -> [PerPoint a] -> Maybe (PerPoint a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PerPoint a
x -> Int -> Int -> Bool
cmp (PerPoint a -> Int
forall a. PerPoint a -> Int
getIdxFromPerPoint PerPoint a
x) Int
i) [PerPoint a]
ps of
        Maybe (PerPoint a)
Nothing -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ PerPoint a -> a
forall a. PerPoint a -> a
getValFromPerPoint ([PerPoint a] -> PerPoint a
forall a. HasCallStack => [a] -> a
last [PerPoint a]
ps)
        Just PerPoint a
rs -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ PerPoint a -> a
forall a. PerPoint a -> a
getValFromPerPoint PerPoint a
rs

getIdxFromPerPoint :: PerPoint a -> Int
getIdxFromPerPoint :: forall a. PerPoint a -> Int
getIdxFromPerPoint (PerPoint Int
i a
_) = Int
i

getValFromPerPoint :: PerPoint a -> a
getValFromPerPoint :: forall a. PerPoint a -> a
getValFromPerPoint (PerPoint Int
_ a
v) = a
v


instance Ord a => Ord (PerPoint a) where
  compare :: PerPoint a -> PerPoint a -> Ordering
compare (PerPoint Int
i a
_) (PerPoint Int
j a
_) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j

data RangeType = II     -- ^ include both start and end date
               | IE     -- ^ include start date ,but not end date
               | EI     -- ^ exclude start date but include end date
               | EE     -- ^ exclude either start date and end date 
               | NO_IE  -- ^ no handling on start date and end date
               deriving (Int -> RangeType -> ShowS
[RangeType] -> ShowS
RangeType -> [Char]
(Int -> RangeType -> ShowS)
-> (RangeType -> [Char])
-> ([RangeType] -> ShowS)
-> Show RangeType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RangeType -> ShowS
showsPrec :: Int -> RangeType -> ShowS
$cshow :: RangeType -> [Char]
show :: RangeType -> [Char]
$cshowList :: [RangeType] -> ShowS
showList :: [RangeType] -> ShowS
Show,RangeType -> RangeType -> Bool
(RangeType -> RangeType -> Bool)
-> (RangeType -> RangeType -> Bool) -> Eq RangeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RangeType -> RangeType -> Bool
== :: RangeType -> RangeType -> Bool
$c/= :: RangeType -> RangeType -> Bool
/= :: RangeType -> RangeType -> Bool
Eq,ReadPrec [RangeType]
ReadPrec RangeType
Int -> ReadS RangeType
ReadS [RangeType]
(Int -> ReadS RangeType)
-> ReadS [RangeType]
-> ReadPrec RangeType
-> ReadPrec [RangeType]
-> Read RangeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RangeType
readsPrec :: Int -> ReadS RangeType
$creadList :: ReadS [RangeType]
readList :: ReadS [RangeType]
$creadPrec :: ReadPrec RangeType
readPrec :: ReadPrec RangeType
$creadListPrec :: ReadPrec [RangeType]
readListPrec :: ReadPrec [RangeType]
Read,(forall x. RangeType -> Rep RangeType x)
-> (forall x. Rep RangeType x -> RangeType) -> Generic RangeType
forall x. Rep RangeType x -> RangeType
forall x. RangeType -> Rep RangeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RangeType -> Rep RangeType x
from :: forall x. RangeType -> Rep RangeType x
$cto :: forall x. Rep RangeType x -> RangeType
to :: forall x. Rep RangeType x -> RangeType
Generic,Eq RangeType
Eq RangeType =>
(RangeType -> RangeType -> Ordering)
-> (RangeType -> RangeType -> Bool)
-> (RangeType -> RangeType -> Bool)
-> (RangeType -> RangeType -> Bool)
-> (RangeType -> RangeType -> Bool)
-> (RangeType -> RangeType -> RangeType)
-> (RangeType -> RangeType -> RangeType)
-> Ord RangeType
RangeType -> RangeType -> Bool
RangeType -> RangeType -> Ordering
RangeType -> RangeType -> RangeType
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 :: RangeType -> RangeType -> Ordering
compare :: RangeType -> RangeType -> Ordering
$c< :: RangeType -> RangeType -> Bool
< :: RangeType -> RangeType -> Bool
$c<= :: RangeType -> RangeType -> Bool
<= :: RangeType -> RangeType -> Bool
$c> :: RangeType -> RangeType -> Bool
> :: RangeType -> RangeType -> Bool
$c>= :: RangeType -> RangeType -> Bool
>= :: RangeType -> RangeType -> Bool
$cmax :: RangeType -> RangeType -> RangeType
max :: RangeType -> RangeType -> RangeType
$cmin :: RangeType -> RangeType -> RangeType
min :: RangeType -> RangeType -> RangeType
Ord)

data CutoffType = Inc 
                | Exc
                deriving (Int -> CutoffType -> ShowS
[CutoffType] -> ShowS
CutoffType -> [Char]
(Int -> CutoffType -> ShowS)
-> (CutoffType -> [Char])
-> ([CutoffType] -> ShowS)
-> Show CutoffType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CutoffType -> ShowS
showsPrec :: Int -> CutoffType -> ShowS
$cshow :: CutoffType -> [Char]
show :: CutoffType -> [Char]
$cshowList :: [CutoffType] -> ShowS
showList :: [CutoffType] -> ShowS
Show,Eq CutoffType
Eq CutoffType =>
(CutoffType -> CutoffType -> Ordering)
-> (CutoffType -> CutoffType -> Bool)
-> (CutoffType -> CutoffType -> Bool)
-> (CutoffType -> CutoffType -> Bool)
-> (CutoffType -> CutoffType -> Bool)
-> (CutoffType -> CutoffType -> CutoffType)
-> (CutoffType -> CutoffType -> CutoffType)
-> Ord CutoffType
CutoffType -> CutoffType -> Bool
CutoffType -> CutoffType -> Ordering
CutoffType -> CutoffType -> CutoffType
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 :: CutoffType -> CutoffType -> Ordering
compare :: CutoffType -> CutoffType -> Ordering
$c< :: CutoffType -> CutoffType -> Bool
< :: CutoffType -> CutoffType -> Bool
$c<= :: CutoffType -> CutoffType -> Bool
<= :: CutoffType -> CutoffType -> Bool
$c> :: CutoffType -> CutoffType -> Bool
> :: CutoffType -> CutoffType -> Bool
$c>= :: CutoffType -> CutoffType -> Bool
>= :: CutoffType -> CutoffType -> Bool
$cmax :: CutoffType -> CutoffType -> CutoffType
max :: CutoffType -> CutoffType -> CutoffType
$cmin :: CutoffType -> CutoffType -> CutoffType
min :: CutoffType -> CutoffType -> CutoffType
Ord,ReadPrec [CutoffType]
ReadPrec CutoffType
Int -> ReadS CutoffType
ReadS [CutoffType]
(Int -> ReadS CutoffType)
-> ReadS [CutoffType]
-> ReadPrec CutoffType
-> ReadPrec [CutoffType]
-> Read CutoffType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CutoffType
readsPrec :: Int -> ReadS CutoffType
$creadList :: ReadS [CutoffType]
readList :: ReadS [CutoffType]
$creadPrec :: ReadPrec CutoffType
readPrec :: ReadPrec CutoffType
$creadListPrec :: ReadPrec [CutoffType]
readListPrec :: ReadPrec [CutoffType]
Read,(forall x. CutoffType -> Rep CutoffType x)
-> (forall x. Rep CutoffType x -> CutoffType) -> Generic CutoffType
forall x. Rep CutoffType x -> CutoffType
forall x. CutoffType -> Rep CutoffType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CutoffType -> Rep CutoffType x
from :: forall x. CutoffType -> Rep CutoffType x
$cto :: forall x. Rep CutoffType x -> CutoffType
to :: forall x. Rep CutoffType x -> CutoffType
Generic,CutoffType -> CutoffType -> Bool
(CutoffType -> CutoffType -> Bool)
-> (CutoffType -> CutoffType -> Bool) -> Eq CutoffType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CutoffType -> CutoffType -> Bool
== :: CutoffType -> CutoffType -> Bool
$c/= :: CutoffType -> CutoffType -> Bool
/= :: CutoffType -> CutoffType -> Bool
Eq)

data DateDirection = Future 
                   | Past
                   deriving (Int -> DateDirection -> ShowS
[DateDirection] -> ShowS
DateDirection -> [Char]
(Int -> DateDirection -> ShowS)
-> (DateDirection -> [Char])
-> ([DateDirection] -> ShowS)
-> Show DateDirection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateDirection -> ShowS
showsPrec :: Int -> DateDirection -> ShowS
$cshow :: DateDirection -> [Char]
show :: DateDirection -> [Char]
$cshowList :: [DateDirection] -> ShowS
showList :: [DateDirection] -> ShowS
Show,ReadPrec [DateDirection]
ReadPrec DateDirection
Int -> ReadS DateDirection
ReadS [DateDirection]
(Int -> ReadS DateDirection)
-> ReadS [DateDirection]
-> ReadPrec DateDirection
-> ReadPrec [DateDirection]
-> Read DateDirection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DateDirection
readsPrec :: Int -> ReadS DateDirection
$creadList :: ReadS [DateDirection]
readList :: ReadS [DateDirection]
$creadPrec :: ReadPrec DateDirection
readPrec :: ReadPrec DateDirection
$creadListPrec :: ReadPrec [DateDirection]
readListPrec :: ReadPrec [DateDirection]
Read,(forall x. DateDirection -> Rep DateDirection x)
-> (forall x. Rep DateDirection x -> DateDirection)
-> Generic DateDirection
forall x. Rep DateDirection x -> DateDirection
forall x. DateDirection -> Rep DateDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DateDirection -> Rep DateDirection x
from :: forall x. DateDirection -> Rep DateDirection x
$cto :: forall x. Rep DateDirection x -> DateDirection
to :: forall x. Rep DateDirection x -> DateDirection
Generic)

data InvestorAction = Buy 
                    | Sell
                    deriving (Int -> InvestorAction -> ShowS
[InvestorAction] -> ShowS
InvestorAction -> [Char]
(Int -> InvestorAction -> ShowS)
-> (InvestorAction -> [Char])
-> ([InvestorAction] -> ShowS)
-> Show InvestorAction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvestorAction -> ShowS
showsPrec :: Int -> InvestorAction -> ShowS
$cshow :: InvestorAction -> [Char]
show :: InvestorAction -> [Char]
$cshowList :: [InvestorAction] -> ShowS
showList :: [InvestorAction] -> ShowS
Show,Eq InvestorAction
Eq InvestorAction =>
(InvestorAction -> InvestorAction -> Ordering)
-> (InvestorAction -> InvestorAction -> Bool)
-> (InvestorAction -> InvestorAction -> Bool)
-> (InvestorAction -> InvestorAction -> Bool)
-> (InvestorAction -> InvestorAction -> Bool)
-> (InvestorAction -> InvestorAction -> InvestorAction)
-> (InvestorAction -> InvestorAction -> InvestorAction)
-> Ord InvestorAction
InvestorAction -> InvestorAction -> Bool
InvestorAction -> InvestorAction -> Ordering
InvestorAction -> InvestorAction -> InvestorAction
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 :: InvestorAction -> InvestorAction -> Ordering
compare :: InvestorAction -> InvestorAction -> Ordering
$c< :: InvestorAction -> InvestorAction -> Bool
< :: InvestorAction -> InvestorAction -> Bool
$c<= :: InvestorAction -> InvestorAction -> Bool
<= :: InvestorAction -> InvestorAction -> Bool
$c> :: InvestorAction -> InvestorAction -> Bool
> :: InvestorAction -> InvestorAction -> Bool
$c>= :: InvestorAction -> InvestorAction -> Bool
>= :: InvestorAction -> InvestorAction -> Bool
$cmax :: InvestorAction -> InvestorAction -> InvestorAction
max :: InvestorAction -> InvestorAction -> InvestorAction
$cmin :: InvestorAction -> InvestorAction -> InvestorAction
min :: InvestorAction -> InvestorAction -> InvestorAction
Ord,ReadPrec [InvestorAction]
ReadPrec InvestorAction
Int -> ReadS InvestorAction
ReadS [InvestorAction]
(Int -> ReadS InvestorAction)
-> ReadS [InvestorAction]
-> ReadPrec InvestorAction
-> ReadPrec [InvestorAction]
-> Read InvestorAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InvestorAction
readsPrec :: Int -> ReadS InvestorAction
$creadList :: ReadS [InvestorAction]
readList :: ReadS [InvestorAction]
$creadPrec :: ReadPrec InvestorAction
readPrec :: ReadPrec InvestorAction
$creadListPrec :: ReadPrec [InvestorAction]
readListPrec :: ReadPrec [InvestorAction]
Read,(forall x. InvestorAction -> Rep InvestorAction x)
-> (forall x. Rep InvestorAction x -> InvestorAction)
-> Generic InvestorAction
forall x. Rep InvestorAction x -> InvestorAction
forall x. InvestorAction -> Rep InvestorAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InvestorAction -> Rep InvestorAction x
from :: forall x. InvestorAction -> Rep InvestorAction x
$cto :: forall x. Rep InvestorAction x -> InvestorAction
to :: forall x. Rep InvestorAction x -> InvestorAction
Generic,InvestorAction -> InvestorAction -> Bool
(InvestorAction -> InvestorAction -> Bool)
-> (InvestorAction -> InvestorAction -> Bool) -> Eq InvestorAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvestorAction -> InvestorAction -> Bool
== :: InvestorAction -> InvestorAction -> Bool
$c/= :: InvestorAction -> InvestorAction -> Bool
/= :: InvestorAction -> InvestorAction -> Bool
Eq)


class TimeSeries ts where 
    cmp :: ts -> ts -> Ordering
    cmp ts
t1 ts
t2 = Day -> Day -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t1) (ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t2)
    sameDate :: ts -> ts -> Bool
    sameDate ts
t1 ts
t2 =  ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t1 Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t2
    getDate :: ts -> Date
    getDates :: [ts] -> [Date]
    getDates [ts]
ts = [ ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t | ts
t <- [ts]
ts ]
    filterByDate :: [ts] -> Date -> [ts]
    filterByDate [ts]
ts Day
d = (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day
d ) [ts]
ts
    sliceBy :: RangeType -> StartDate -> EndDate -> [ts] -> [ts]
    sliceBy RangeType
rt Day
sd Day
ed [ts]
ts
      = case RangeType
rt of 
          RangeType
II -> (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
sd Bool -> Bool -> Bool
&& ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
ed ) [ts]
ts 
          RangeType
IE -> (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
sd Bool -> Bool -> Bool
&& ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
ed ) [ts]
ts 
          RangeType
EI -> (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
sd Bool -> Bool -> Bool
&& ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
ed) [ts]
ts 
          RangeType
EE -> (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
sd Bool -> Bool -> Bool
&& ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
ed ) [ts]
ts 
          RangeType
_  -> [Char] -> [ts]
forall a. HasCallStack => [Char] -> a
error [Char]
"Not support NO_IE for sliceBy in TimeSeries"
    cutBy :: CutoffType -> DateDirection -> Date -> [ts] -> [ts]
    cutBy CutoffType
ct DateDirection
dd Day
d [ts]
ts 
      = case (CutoffType
ct,DateDirection
dd) of
          (CutoffType
Inc, DateDirection
Future) ->  (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
d) [ts]
ts
          (CutoffType
Inc, DateDirection
Past) ->  (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
d) [ts]
ts
          (CutoffType
Exc, DateDirection
Future) ->  (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
d) [ts]
ts
          (CutoffType
Exc, DateDirection
Past) ->  (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ts
x -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
d) [ts]
ts

    cmpWith :: ts -> Date -> Ordering
    cmpWith ts
t Day
d = Day -> Day -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t) Day
d

    isAfter :: ts -> Date -> Bool 
    isAfter ts
t Day
d = ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
d
    isOnAfter :: ts -> Date -> Bool 
    isOnAfter ts
t Day
d = ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
d
    isBefore :: ts -> Date -> Bool 
    isBefore ts
t Day
d = ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
d
    isOnBefore :: ts -> Date -> Bool 
    isOnBefore ts
t Day
d = ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
t Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
d

    splitBy :: Date -> CutoffType -> [ts] -> ([ts],[ts])
    splitBy Day
d CutoffType
ct [ts]
tss = 
      let 
        ffunR :: ts -> Bool
ffunR ts
x = case CutoffType
ct of
                    CutoffType
Inc -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
d -- include ts in the Left
                    CutoffType
Exc -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
d  -- 
        ffunL :: ts -> Bool
ffunL ts
x = case CutoffType
ct of
                    CutoffType
Inc -> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
d -- include ts in the Left
                    CutoffType
Exc-> ts -> Day
forall ts. TimeSeries ts => ts -> Day
getDate ts
x Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
d  -- 
      in 
        ((ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter ts -> Bool
forall {ts}. TimeSeries ts => ts -> Bool
ffunL [ts]
tss, (ts -> Bool) -> [ts] -> [ts]
forall a. (a -> Bool) -> [a] -> [a]
filter ts -> Bool
forall {ts}. TimeSeries ts => ts -> Bool
ffunR [ts]
tss)

    getByDate :: Date -> [ts] -> Maybe ts
    getByDate Day
d [ts]
ts = case [ts] -> Day -> [ts]
forall ts. TimeSeries ts => [ts] -> Day -> [ts]
filterByDate [ts]
ts Day
d of 
                      [] -> Maybe ts
forall a. Maybe a
Nothing
                      (ts
x:[ts]
_) -> ts -> Maybe ts
forall a. a -> Maybe a
Just ts
x
 
-- ^ different types of curves, which determine how to interpolate between two points
data Ts = FloatCurve [TsPoint Rational]
        | BoolCurve [TsPoint Bool]
        | BalanceCurve [TsPoint Balance]
        | LeftBalanceCurve [TsPoint Balance]
        | RatioCurve [TsPoint Rational]
        | ThresholdCurve [TsPoint Rational]
        | IRateCurve [TsPoint IRate]
        | FactorCurveClosed [TsPoint Rational] Date
        | PricingCurve [TsPoint Rational] 
        | PeriodCurve [TsPoint Int]
        | IntCurve [TsPoint Int]
        deriving (Int -> Ts -> ShowS
[Ts] -> ShowS
Ts -> [Char]
(Int -> Ts -> ShowS)
-> (Ts -> [Char]) -> ([Ts] -> ShowS) -> Show Ts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ts -> ShowS
showsPrec :: Int -> Ts -> ShowS
$cshow :: Ts -> [Char]
show :: Ts -> [Char]
$cshowList :: [Ts] -> ShowS
showList :: [Ts] -> ShowS
Show,Ts -> Ts -> Bool
(Ts -> Ts -> Bool) -> (Ts -> Ts -> Bool) -> Eq Ts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ts -> Ts -> Bool
== :: Ts -> Ts -> Bool
$c/= :: Ts -> Ts -> Bool
/= :: Ts -> Ts -> Bool
Eq,Eq Ts
Eq Ts =>
(Ts -> Ts -> Ordering)
-> (Ts -> Ts -> Bool)
-> (Ts -> Ts -> Bool)
-> (Ts -> Ts -> Bool)
-> (Ts -> Ts -> Bool)
-> (Ts -> Ts -> Ts)
-> (Ts -> Ts -> Ts)
-> Ord Ts
Ts -> Ts -> Bool
Ts -> Ts -> Ordering
Ts -> Ts -> Ts
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 :: Ts -> Ts -> Ordering
compare :: Ts -> Ts -> Ordering
$c< :: Ts -> Ts -> Bool
< :: Ts -> Ts -> Bool
$c<= :: Ts -> Ts -> Bool
<= :: Ts -> Ts -> Bool
$c> :: Ts -> Ts -> Bool
> :: Ts -> Ts -> Bool
$c>= :: Ts -> Ts -> Bool
>= :: Ts -> Ts -> Bool
$cmax :: Ts -> Ts -> Ts
max :: Ts -> Ts -> Ts
$cmin :: Ts -> Ts -> Ts
min :: Ts -> Ts -> Ts
Ord,ReadPrec [Ts]
ReadPrec Ts
Int -> ReadS Ts
ReadS [Ts]
(Int -> ReadS Ts)
-> ReadS [Ts] -> ReadPrec Ts -> ReadPrec [Ts] -> Read Ts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Ts
readsPrec :: Int -> ReadS Ts
$creadList :: ReadS [Ts]
readList :: ReadS [Ts]
$creadPrec :: ReadPrec Ts
readPrec :: ReadPrec Ts
$creadListPrec :: ReadPrec [Ts]
readListPrec :: ReadPrec [Ts]
Read,(forall x. Ts -> Rep Ts x)
-> (forall x. Rep Ts x -> Ts) -> Generic Ts
forall x. Rep Ts x -> Ts
forall x. Ts -> Rep Ts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ts -> Rep Ts x
from :: forall x. Ts -> Rep Ts x
$cto :: forall x. Rep Ts x -> Ts
to :: forall x. Rep Ts x -> Ts
Generic)


data Direction = Up 
               | Down
               deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> [Char]
(Int -> Direction -> ShowS)
-> (Direction -> [Char])
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> [Char]
show :: Direction -> [Char]
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show,ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Direction
readsPrec :: Int -> ReadS Direction
$creadList :: ReadS [Direction]
readList :: ReadS [Direction]
$creadPrec :: ReadPrec Direction
readPrec :: ReadPrec Direction
$creadListPrec :: ReadPrec [Direction]
readListPrec :: ReadPrec [Direction]
Read,(forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Direction -> Rep Direction x
from :: forall x. Direction -> Rep Direction x
$cto :: forall x. Rep Direction x -> Direction
to :: forall x. Rep Direction x -> Direction
Generic,Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq,Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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 :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord)

-- ^ direction of the transaction, in terms of the book keeping
data BookDirection = Credit
                   | Debit
                   deriving (Int -> BookDirection -> ShowS
[BookDirection] -> ShowS
BookDirection -> [Char]
(Int -> BookDirection -> ShowS)
-> (BookDirection -> [Char])
-> ([BookDirection] -> ShowS)
-> Show BookDirection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BookDirection -> ShowS
showsPrec :: Int -> BookDirection -> ShowS
$cshow :: BookDirection -> [Char]
show :: BookDirection -> [Char]
$cshowList :: [BookDirection] -> ShowS
showList :: [BookDirection] -> ShowS
Show,Eq BookDirection
Eq BookDirection =>
(BookDirection -> BookDirection -> Ordering)
-> (BookDirection -> BookDirection -> Bool)
-> (BookDirection -> BookDirection -> Bool)
-> (BookDirection -> BookDirection -> Bool)
-> (BookDirection -> BookDirection -> Bool)
-> (BookDirection -> BookDirection -> BookDirection)
-> (BookDirection -> BookDirection -> BookDirection)
-> Ord BookDirection
BookDirection -> BookDirection -> Bool
BookDirection -> BookDirection -> Ordering
BookDirection -> BookDirection -> BookDirection
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 :: BookDirection -> BookDirection -> Ordering
compare :: BookDirection -> BookDirection -> Ordering
$c< :: BookDirection -> BookDirection -> Bool
< :: BookDirection -> BookDirection -> Bool
$c<= :: BookDirection -> BookDirection -> Bool
<= :: BookDirection -> BookDirection -> Bool
$c> :: BookDirection -> BookDirection -> Bool
> :: BookDirection -> BookDirection -> Bool
$c>= :: BookDirection -> BookDirection -> Bool
>= :: BookDirection -> BookDirection -> Bool
$cmax :: BookDirection -> BookDirection -> BookDirection
max :: BookDirection -> BookDirection -> BookDirection
$cmin :: BookDirection -> BookDirection -> BookDirection
min :: BookDirection -> BookDirection -> BookDirection
Ord, BookDirection -> BookDirection -> Bool
(BookDirection -> BookDirection -> Bool)
-> (BookDirection -> BookDirection -> Bool) -> Eq BookDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BookDirection -> BookDirection -> Bool
== :: BookDirection -> BookDirection -> Bool
$c/= :: BookDirection -> BookDirection -> Bool
/= :: BookDirection -> BookDirection -> Bool
Eq,ReadPrec [BookDirection]
ReadPrec BookDirection
Int -> ReadS BookDirection
ReadS [BookDirection]
(Int -> ReadS BookDirection)
-> ReadS [BookDirection]
-> ReadPrec BookDirection
-> ReadPrec [BookDirection]
-> Read BookDirection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BookDirection
readsPrec :: Int -> ReadS BookDirection
$creadList :: ReadS [BookDirection]
readList :: ReadS [BookDirection]
$creadPrec :: ReadPrec BookDirection
readPrec :: ReadPrec BookDirection
$creadListPrec :: ReadPrec [BookDirection]
readListPrec :: ReadPrec [BookDirection]
Read, (forall x. BookDirection -> Rep BookDirection x)
-> (forall x. Rep BookDirection x -> BookDirection)
-> Generic BookDirection
forall x. Rep BookDirection x -> BookDirection
forall x. BookDirection -> Rep BookDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BookDirection -> Rep BookDirection x
from :: forall x. BookDirection -> Rep BookDirection x
$cto :: forall x. Rep BookDirection x -> BookDirection
to :: forall x. Rep BookDirection x -> BookDirection
Generic)


type DueInt = Balance
type DuePremium = Balance
type DueIoI = Balance

data DealCycle = EndCollection         -- ^ | collection period <HERE> collection action , waterfall action
               | EndCollectionWF       -- ^ | collection period  collection action <HERE>, waterfall action
               | BeginDistributionWF   -- ^ | collection period  collection action , <HERE>waterfall action
               | EndDistributionWF     -- ^ | collection period  collection action , waterfall action<HERE>
               | InWF                  -- ^ | collection period  collection action , waterfall <HERE> action
               deriving (Int -> DealCycle -> ShowS
[DealCycle] -> ShowS
DealCycle -> [Char]
(Int -> DealCycle -> ShowS)
-> (DealCycle -> [Char])
-> ([DealCycle] -> ShowS)
-> Show DealCycle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DealCycle -> ShowS
showsPrec :: Int -> DealCycle -> ShowS
$cshow :: DealCycle -> [Char]
show :: DealCycle -> [Char]
$cshowList :: [DealCycle] -> ShowS
showList :: [DealCycle] -> ShowS
Show, Eq DealCycle
Eq DealCycle =>
(DealCycle -> DealCycle -> Ordering)
-> (DealCycle -> DealCycle -> Bool)
-> (DealCycle -> DealCycle -> Bool)
-> (DealCycle -> DealCycle -> Bool)
-> (DealCycle -> DealCycle -> Bool)
-> (DealCycle -> DealCycle -> DealCycle)
-> (DealCycle -> DealCycle -> DealCycle)
-> Ord DealCycle
DealCycle -> DealCycle -> Bool
DealCycle -> DealCycle -> Ordering
DealCycle -> DealCycle -> DealCycle
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 :: DealCycle -> DealCycle -> Ordering
compare :: DealCycle -> DealCycle -> Ordering
$c< :: DealCycle -> DealCycle -> Bool
< :: DealCycle -> DealCycle -> Bool
$c<= :: DealCycle -> DealCycle -> Bool
<= :: DealCycle -> DealCycle -> Bool
$c> :: DealCycle -> DealCycle -> Bool
> :: DealCycle -> DealCycle -> Bool
$c>= :: DealCycle -> DealCycle -> Bool
>= :: DealCycle -> DealCycle -> Bool
$cmax :: DealCycle -> DealCycle -> DealCycle
max :: DealCycle -> DealCycle -> DealCycle
$cmin :: DealCycle -> DealCycle -> DealCycle
min :: DealCycle -> DealCycle -> DealCycle
Ord, DealCycle -> DealCycle -> Bool
(DealCycle -> DealCycle -> Bool)
-> (DealCycle -> DealCycle -> Bool) -> Eq DealCycle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DealCycle -> DealCycle -> Bool
== :: DealCycle -> DealCycle -> Bool
$c/= :: DealCycle -> DealCycle -> Bool
/= :: DealCycle -> DealCycle -> Bool
Eq, ReadPrec [DealCycle]
ReadPrec DealCycle
Int -> ReadS DealCycle
ReadS [DealCycle]
(Int -> ReadS DealCycle)
-> ReadS [DealCycle]
-> ReadPrec DealCycle
-> ReadPrec [DealCycle]
-> Read DealCycle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DealCycle
readsPrec :: Int -> ReadS DealCycle
$creadList :: ReadS [DealCycle]
readList :: ReadS [DealCycle]
$creadPrec :: ReadPrec DealCycle
readPrec :: ReadPrec DealCycle
$creadListPrec :: ReadPrec [DealCycle]
readListPrec :: ReadPrec [DealCycle]
Read, (forall x. DealCycle -> Rep DealCycle x)
-> (forall x. Rep DealCycle x -> DealCycle) -> Generic DealCycle
forall x. Rep DealCycle x -> DealCycle
forall x. DealCycle -> Rep DealCycle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DealCycle -> Rep DealCycle x
from :: forall x. DealCycle -> Rep DealCycle x
$cto :: forall x. Rep DealCycle x -> DealCycle
to :: forall x. Rep DealCycle x -> DealCycle
Generic)

-- ^ different status of the deal
data DealStatus = DealAccelerated (Maybe Date)      -- ^ Deal is accelerated status with optinal accerlerated date
                | DealDefaulted (Maybe Date)        -- ^ Deal is defaulted status with optinal default date
                | Amortizing                        -- ^ Deal is amortizing 
                | Revolving                         -- ^ Deal is revolving
                | PreClosing DealStatus             -- ^ Deal is not closed, but has a closing date
                | Warehousing (Maybe DealStatus)    -- ^ Deal is not closed, but closing date is not determined yet
                | Called                            -- ^ Deal is called
                | Ended Date                        -- ^ Deal is marked as closed
                deriving (Int -> DealStatus -> ShowS
[DealStatus] -> ShowS
DealStatus -> [Char]
(Int -> DealStatus -> ShowS)
-> (DealStatus -> [Char])
-> ([DealStatus] -> ShowS)
-> Show DealStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DealStatus -> ShowS
showsPrec :: Int -> DealStatus -> ShowS
$cshow :: DealStatus -> [Char]
show :: DealStatus -> [Char]
$cshowList :: [DealStatus] -> ShowS
showList :: [DealStatus] -> ShowS
Show,Eq DealStatus
Eq DealStatus =>
(DealStatus -> DealStatus -> Ordering)
-> (DealStatus -> DealStatus -> Bool)
-> (DealStatus -> DealStatus -> Bool)
-> (DealStatus -> DealStatus -> Bool)
-> (DealStatus -> DealStatus -> Bool)
-> (DealStatus -> DealStatus -> DealStatus)
-> (DealStatus -> DealStatus -> DealStatus)
-> Ord DealStatus
DealStatus -> DealStatus -> Bool
DealStatus -> DealStatus -> Ordering
DealStatus -> DealStatus -> DealStatus
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 :: DealStatus -> DealStatus -> Ordering
compare :: DealStatus -> DealStatus -> Ordering
$c< :: DealStatus -> DealStatus -> Bool
< :: DealStatus -> DealStatus -> Bool
$c<= :: DealStatus -> DealStatus -> Bool
<= :: DealStatus -> DealStatus -> Bool
$c> :: DealStatus -> DealStatus -> Bool
> :: DealStatus -> DealStatus -> Bool
$c>= :: DealStatus -> DealStatus -> Bool
>= :: DealStatus -> DealStatus -> Bool
$cmax :: DealStatus -> DealStatus -> DealStatus
max :: DealStatus -> DealStatus -> DealStatus
$cmin :: DealStatus -> DealStatus -> DealStatus
min :: DealStatus -> DealStatus -> DealStatus
Ord,DealStatus -> DealStatus -> Bool
(DealStatus -> DealStatus -> Bool)
-> (DealStatus -> DealStatus -> Bool) -> Eq DealStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DealStatus -> DealStatus -> Bool
== :: DealStatus -> DealStatus -> Bool
$c/= :: DealStatus -> DealStatus -> Bool
/= :: DealStatus -> DealStatus -> Bool
Eq,ReadPrec [DealStatus]
ReadPrec DealStatus
Int -> ReadS DealStatus
ReadS [DealStatus]
(Int -> ReadS DealStatus)
-> ReadS [DealStatus]
-> ReadPrec DealStatus
-> ReadPrec [DealStatus]
-> Read DealStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DealStatus
readsPrec :: Int -> ReadS DealStatus
$creadList :: ReadS [DealStatus]
readList :: ReadS [DealStatus]
$creadPrec :: ReadPrec DealStatus
readPrec :: ReadPrec DealStatus
$creadListPrec :: ReadPrec [DealStatus]
readListPrec :: ReadPrec [DealStatus]
Read, (forall x. DealStatus -> Rep DealStatus x)
-> (forall x. Rep DealStatus x -> DealStatus) -> Generic DealStatus
forall x. Rep DealStatus x -> DealStatus
forall x. DealStatus -> Rep DealStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DealStatus -> Rep DealStatus x
from :: forall x. DealStatus -> Rep DealStatus x
$cto :: forall x. Rep DealStatus x -> DealStatus
to :: forall x. Rep DealStatus x -> DealStatus
Generic)

-- ^ pricing methods for assets
data PricingMethod = BalanceFactor Rate Rate          -- ^ [balance] to be multiply with rate1 and rate2 if status of asset is "performing" or "defaulted"
                   | BalanceFactor2 Rate Rate Rate    -- ^ [balance] by performing/delinq/default factor
                   | DefaultedBalance Rate            -- ^ [balance] only liquidate defaulted balance
                   | PV IRate Rate                    -- ^ discount factor, recovery pct on default
                   | PVCurve Ts                       -- ^ [CF] Pricing cashflow with a Curve
                   | PvRate IRate                     -- ^ [CF] Pricing cashflow with a constant rate
                   | PvWal Ts
                   | PvByRef DealStats                -- ^ [CF] Pricing cashflow with a ref rate
                   | Custom Rate                      -- ^ custom amount
                   deriving (Int -> PricingMethod -> ShowS
[PricingMethod] -> ShowS
PricingMethod -> [Char]
(Int -> PricingMethod -> ShowS)
-> (PricingMethod -> [Char])
-> ([PricingMethod] -> ShowS)
-> Show PricingMethod
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PricingMethod -> ShowS
showsPrec :: Int -> PricingMethod -> ShowS
$cshow :: PricingMethod -> [Char]
show :: PricingMethod -> [Char]
$cshowList :: [PricingMethod] -> ShowS
showList :: [PricingMethod] -> ShowS
Show, PricingMethod -> PricingMethod -> Bool
(PricingMethod -> PricingMethod -> Bool)
-> (PricingMethod -> PricingMethod -> Bool) -> Eq PricingMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PricingMethod -> PricingMethod -> Bool
== :: PricingMethod -> PricingMethod -> Bool
$c/= :: PricingMethod -> PricingMethod -> Bool
/= :: PricingMethod -> PricingMethod -> Bool
Eq ,(forall x. PricingMethod -> Rep PricingMethod x)
-> (forall x. Rep PricingMethod x -> PricingMethod)
-> Generic PricingMethod
forall x. Rep PricingMethod x -> PricingMethod
forall x. PricingMethod -> Rep PricingMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PricingMethod -> Rep PricingMethod x
from :: forall x. PricingMethod -> Rep PricingMethod x
$cto :: forall x. Rep PricingMethod x -> PricingMethod
to :: forall x. Rep PricingMethod x -> PricingMethod
Generic, ReadPrec [PricingMethod]
ReadPrec PricingMethod
Int -> ReadS PricingMethod
ReadS [PricingMethod]
(Int -> ReadS PricingMethod)
-> ReadS [PricingMethod]
-> ReadPrec PricingMethod
-> ReadPrec [PricingMethod]
-> Read PricingMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PricingMethod
readsPrec :: Int -> ReadS PricingMethod
$creadList :: ReadS [PricingMethod]
readList :: ReadS [PricingMethod]
$creadPrec :: ReadPrec PricingMethod
readPrec :: ReadPrec PricingMethod
$creadListPrec :: ReadPrec [PricingMethod]
readListPrec :: ReadPrec [PricingMethod]
Read, Eq PricingMethod
Eq PricingMethod =>
(PricingMethod -> PricingMethod -> Ordering)
-> (PricingMethod -> PricingMethod -> Bool)
-> (PricingMethod -> PricingMethod -> Bool)
-> (PricingMethod -> PricingMethod -> Bool)
-> (PricingMethod -> PricingMethod -> Bool)
-> (PricingMethod -> PricingMethod -> PricingMethod)
-> (PricingMethod -> PricingMethod -> PricingMethod)
-> Ord PricingMethod
PricingMethod -> PricingMethod -> Bool
PricingMethod -> PricingMethod -> Ordering
PricingMethod -> PricingMethod -> PricingMethod
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 :: PricingMethod -> PricingMethod -> Ordering
compare :: PricingMethod -> PricingMethod -> Ordering
$c< :: PricingMethod -> PricingMethod -> Bool
< :: PricingMethod -> PricingMethod -> Bool
$c<= :: PricingMethod -> PricingMethod -> Bool
<= :: PricingMethod -> PricingMethod -> Bool
$c> :: PricingMethod -> PricingMethod -> Bool
> :: PricingMethod -> PricingMethod -> Bool
$c>= :: PricingMethod -> PricingMethod -> Bool
>= :: PricingMethod -> PricingMethod -> Bool
$cmax :: PricingMethod -> PricingMethod -> PricingMethod
max :: PricingMethod -> PricingMethod -> PricingMethod
$cmin :: PricingMethod -> PricingMethod -> PricingMethod
min :: PricingMethod -> PricingMethod -> PricingMethod
Ord)

-- ^ pricing methods for bonds
data BondPricingMethod = BondBalanceFactor Rate 
                        | PvBondByRate Rate
                        | PvBondByCurve Ts
                        deriving (Int -> BondPricingMethod -> ShowS
[BondPricingMethod] -> ShowS
BondPricingMethod -> [Char]
(Int -> BondPricingMethod -> ShowS)
-> (BondPricingMethod -> [Char])
-> ([BondPricingMethod] -> ShowS)
-> Show BondPricingMethod
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BondPricingMethod -> ShowS
showsPrec :: Int -> BondPricingMethod -> ShowS
$cshow :: BondPricingMethod -> [Char]
show :: BondPricingMethod -> [Char]
$cshowList :: [BondPricingMethod] -> ShowS
showList :: [BondPricingMethod] -> ShowS
Show, BondPricingMethod -> BondPricingMethod -> Bool
(BondPricingMethod -> BondPricingMethod -> Bool)
-> (BondPricingMethod -> BondPricingMethod -> Bool)
-> Eq BondPricingMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BondPricingMethod -> BondPricingMethod -> Bool
== :: BondPricingMethod -> BondPricingMethod -> Bool
$c/= :: BondPricingMethod -> BondPricingMethod -> Bool
/= :: BondPricingMethod -> BondPricingMethod -> Bool
Eq ,(forall x. BondPricingMethod -> Rep BondPricingMethod x)
-> (forall x. Rep BondPricingMethod x -> BondPricingMethod)
-> Generic BondPricingMethod
forall x. Rep BondPricingMethod x -> BondPricingMethod
forall x. BondPricingMethod -> Rep BondPricingMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BondPricingMethod -> Rep BondPricingMethod x
from :: forall x. BondPricingMethod -> Rep BondPricingMethod x
$cto :: forall x. Rep BondPricingMethod x -> BondPricingMethod
to :: forall x. Rep BondPricingMethod x -> BondPricingMethod
Generic, ReadPrec [BondPricingMethod]
ReadPrec BondPricingMethod
Int -> ReadS BondPricingMethod
ReadS [BondPricingMethod]
(Int -> ReadS BondPricingMethod)
-> ReadS [BondPricingMethod]
-> ReadPrec BondPricingMethod
-> ReadPrec [BondPricingMethod]
-> Read BondPricingMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BondPricingMethod
readsPrec :: Int -> ReadS BondPricingMethod
$creadList :: ReadS [BondPricingMethod]
readList :: ReadS [BondPricingMethod]
$creadPrec :: ReadPrec BondPricingMethod
readPrec :: ReadPrec BondPricingMethod
$creadListPrec :: ReadPrec [BondPricingMethod]
readListPrec :: ReadPrec [BondPricingMethod]
Read, Eq BondPricingMethod
Eq BondPricingMethod =>
(BondPricingMethod -> BondPricingMethod -> Ordering)
-> (BondPricingMethod -> BondPricingMethod -> Bool)
-> (BondPricingMethod -> BondPricingMethod -> Bool)
-> (BondPricingMethod -> BondPricingMethod -> Bool)
-> (BondPricingMethod -> BondPricingMethod -> Bool)
-> (BondPricingMethod -> BondPricingMethod -> BondPricingMethod)
-> (BondPricingMethod -> BondPricingMethod -> BondPricingMethod)
-> Ord BondPricingMethod
BondPricingMethod -> BondPricingMethod -> Bool
BondPricingMethod -> BondPricingMethod -> Ordering
BondPricingMethod -> BondPricingMethod -> BondPricingMethod
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 :: BondPricingMethod -> BondPricingMethod -> Ordering
compare :: BondPricingMethod -> BondPricingMethod -> Ordering
$c< :: BondPricingMethod -> BondPricingMethod -> Bool
< :: BondPricingMethod -> BondPricingMethod -> Bool
$c<= :: BondPricingMethod -> BondPricingMethod -> Bool
<= :: BondPricingMethod -> BondPricingMethod -> Bool
$c> :: BondPricingMethod -> BondPricingMethod -> Bool
> :: BondPricingMethod -> BondPricingMethod -> Bool
$c>= :: BondPricingMethod -> BondPricingMethod -> Bool
>= :: BondPricingMethod -> BondPricingMethod -> Bool
$cmax :: BondPricingMethod -> BondPricingMethod -> BondPricingMethod
max :: BondPricingMethod -> BondPricingMethod -> BondPricingMethod
$cmin :: BondPricingMethod -> BondPricingMethod -> BondPricingMethod
min :: BondPricingMethod -> BondPricingMethod -> BondPricingMethod
Ord)


-- ^ condition which can be evaluated to a boolean value
data Pre = IfZero DealStats
        | If Cmp DealStats Balance
        | IfRate Cmp DealStats Micro
        | IfCurve Cmp DealStats Ts
        | IfByPeriodCurve Cmp DealStats DealStats (PerCurve Balance)
        | IfRateCurve Cmp DealStats Ts
        | IfRateByPeriodCurve Cmp DealStats DealStats (PerCurve Rate)
        | IfIntCurve Cmp DealStats Ts
        -- Integer
        | IfInt Cmp DealStats Int
        | IfIntBetween DealStats RangeType Int Int
        | IfIntIn DealStats [Int]
        -- Dates
        | IfDate Cmp Date
        | IfDateBetween RangeType Date Date
        | IfDateIn Dates
        -- Bool
        | IfBool DealStats Bool
        -- compare deal status 
        | If2 Cmp DealStats DealStats
        | IfRate2 Cmp DealStats DealStats
        | IfInt2 Cmp DealStats DealStats
        -- | IfRateCurve DealStats Cmp Ts
        | IfDealStatus DealStatus
        | Always Bool
        | IfNot Pre
        | Any [Pre]
        | All [Pre]                            -- ^ 
        deriving (Int -> Pre -> ShowS
[Pre] -> ShowS
Pre -> [Char]
(Int -> Pre -> ShowS)
-> (Pre -> [Char]) -> ([Pre] -> ShowS) -> Show Pre
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pre -> ShowS
showsPrec :: Int -> Pre -> ShowS
$cshow :: Pre -> [Char]
show :: Pre -> [Char]
$cshowList :: [Pre] -> ShowS
showList :: [Pre] -> ShowS
Show,(forall x. Pre -> Rep Pre x)
-> (forall x. Rep Pre x -> Pre) -> Generic Pre
forall x. Rep Pre x -> Pre
forall x. Pre -> Rep Pre x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pre -> Rep Pre x
from :: forall x. Pre -> Rep Pre x
$cto :: forall x. Rep Pre x -> Pre
to :: forall x. Rep Pre x -> Pre
Generic,Pre -> Pre -> Bool
(Pre -> Pre -> Bool) -> (Pre -> Pre -> Bool) -> Eq Pre
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pre -> Pre -> Bool
== :: Pre -> Pre -> Bool
$c/= :: Pre -> Pre -> Bool
/= :: Pre -> Pre -> Bool
Eq,Eq Pre
Eq Pre =>
(Pre -> Pre -> Ordering)
-> (Pre -> Pre -> Bool)
-> (Pre -> Pre -> Bool)
-> (Pre -> Pre -> Bool)
-> (Pre -> Pre -> Bool)
-> (Pre -> Pre -> Pre)
-> (Pre -> Pre -> Pre)
-> Ord Pre
Pre -> Pre -> Bool
Pre -> Pre -> Ordering
Pre -> Pre -> Pre
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 :: Pre -> Pre -> Ordering
compare :: Pre -> Pre -> Ordering
$c< :: Pre -> Pre -> Bool
< :: Pre -> Pre -> Bool
$c<= :: Pre -> Pre -> Bool
<= :: Pre -> Pre -> Bool
$c> :: Pre -> Pre -> Bool
> :: Pre -> Pre -> Bool
$c>= :: Pre -> Pre -> Bool
>= :: Pre -> Pre -> Bool
$cmax :: Pre -> Pre -> Pre
max :: Pre -> Pre -> Pre
$cmin :: Pre -> Pre -> Pre
min :: Pre -> Pre -> Pre
Ord,ReadPrec [Pre]
ReadPrec Pre
Int -> ReadS Pre
ReadS [Pre]
(Int -> ReadS Pre)
-> ReadS [Pre] -> ReadPrec Pre -> ReadPrec [Pre] -> Read Pre
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Pre
readsPrec :: Int -> ReadS Pre
$creadList :: ReadS [Pre]
readList :: ReadS [Pre]
$creadPrec :: ReadPrec Pre
readPrec :: ReadPrec Pre
$creadListPrec :: ReadPrec [Pre]
readListPrec :: ReadPrec [Pre]
Read)


data Table a b = ThresholdTable [(a,b)]
                 deriving (Int -> Table a b -> ShowS
[Table a b] -> ShowS
Table a b -> [Char]
(Int -> Table a b -> ShowS)
-> (Table a b -> [Char])
-> ([Table a b] -> ShowS)
-> Show (Table a b)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Table a b -> ShowS
forall a b. (Show a, Show b) => [Table a b] -> ShowS
forall a b. (Show a, Show b) => Table a b -> [Char]
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Table a b -> ShowS
showsPrec :: Int -> Table a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Table a b -> [Char]
show :: Table a b -> [Char]
$cshowList :: forall a b. (Show a, Show b) => [Table a b] -> ShowS
showList :: [Table a b] -> ShowS
Show,Table a b -> Table a b -> Bool
(Table a b -> Table a b -> Bool)
-> (Table a b -> Table a b -> Bool) -> Eq (Table a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Table a b -> Table a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Table a b -> Table a b -> Bool
== :: Table a b -> Table a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Table a b -> Table a b -> Bool
/= :: Table a b -> Table a b -> Bool
Eq,Eq (Table a b)
Eq (Table a b) =>
(Table a b -> Table a b -> Ordering)
-> (Table a b -> Table a b -> Bool)
-> (Table a b -> Table a b -> Bool)
-> (Table a b -> Table a b -> Bool)
-> (Table a b -> Table a b -> Bool)
-> (Table a b -> Table a b -> Table a b)
-> (Table a b -> Table a b -> Table a b)
-> Ord (Table a b)
Table a b -> Table a b -> Bool
Table a b -> Table a b -> Ordering
Table a b -> Table a b -> Table a b
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
forall a b. (Ord a, Ord b) => Eq (Table a b)
forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Bool
forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Ordering
forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Table a b
$ccompare :: forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Ordering
compare :: Table a b -> Table a b -> Ordering
$c< :: forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Bool
< :: Table a b -> Table a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Bool
<= :: Table a b -> Table a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Bool
> :: Table a b -> Table a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Bool
>= :: Table a b -> Table a b -> Bool
$cmax :: forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Table a b
max :: Table a b -> Table a b -> Table a b
$cmin :: forall a b. (Ord a, Ord b) => Table a b -> Table a b -> Table a b
min :: Table a b -> Table a b -> Table a b
Ord,ReadPrec [Table a b]
ReadPrec (Table a b)
Int -> ReadS (Table a b)
ReadS [Table a b]
(Int -> ReadS (Table a b))
-> ReadS [Table a b]
-> ReadPrec (Table a b)
-> ReadPrec [Table a b]
-> Read (Table a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [Table a b]
forall a b. (Read a, Read b) => ReadPrec (Table a b)
forall a b. (Read a, Read b) => Int -> ReadS (Table a b)
forall a b. (Read a, Read b) => ReadS [Table a b]
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Table a b)
readsPrec :: Int -> ReadS (Table a b)
$creadList :: forall a b. (Read a, Read b) => ReadS [Table a b]
readList :: ReadS [Table a b]
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Table a b)
readPrec :: ReadPrec (Table a b)
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Table a b]
readListPrec :: ReadPrec [Table a b]
Read,(forall x. Table a b -> Rep (Table a b) x)
-> (forall x. Rep (Table a b) x -> Table a b)
-> Generic (Table a b)
forall x. Rep (Table a b) x -> Table a b
forall x. Table a b -> Rep (Table a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Table a b) x -> Table a b
forall a b x. Table a b -> Rep (Table a b) x
$cfrom :: forall a b x. Table a b -> Rep (Table a b) x
from :: forall x. Table a b -> Rep (Table a b) x
$cto :: forall a b x. Rep (Table a b) x -> Table a b
to :: forall x. Rep (Table a b) x -> Table a b
Generic)


data ActionType = ActionResetRate  -- ^ reset interest rate from curve
                | ActionAccrue     -- ^ accrue liablity
                 deriving (Int -> ActionType -> ShowS
[ActionType] -> ShowS
ActionType -> [Char]
(Int -> ActionType -> ShowS)
-> (ActionType -> [Char])
-> ([ActionType] -> ShowS)
-> Show ActionType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionType -> ShowS
showsPrec :: Int -> ActionType -> ShowS
$cshow :: ActionType -> [Char]
show :: ActionType -> [Char]
$cshowList :: [ActionType] -> ShowS
showList :: [ActionType] -> ShowS
Show,ActionType -> ActionType -> Bool
(ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool) -> Eq ActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionType -> ActionType -> Bool
== :: ActionType -> ActionType -> Bool
$c/= :: ActionType -> ActionType -> Bool
/= :: ActionType -> ActionType -> Bool
Eq,Eq ActionType
Eq ActionType =>
(ActionType -> ActionType -> Ordering)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> ActionType)
-> (ActionType -> ActionType -> ActionType)
-> Ord ActionType
ActionType -> ActionType -> Bool
ActionType -> ActionType -> Ordering
ActionType -> ActionType -> ActionType
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 :: ActionType -> ActionType -> Ordering
compare :: ActionType -> ActionType -> Ordering
$c< :: ActionType -> ActionType -> Bool
< :: ActionType -> ActionType -> Bool
$c<= :: ActionType -> ActionType -> Bool
<= :: ActionType -> ActionType -> Bool
$c> :: ActionType -> ActionType -> Bool
> :: ActionType -> ActionType -> Bool
$c>= :: ActionType -> ActionType -> Bool
>= :: ActionType -> ActionType -> Bool
$cmax :: ActionType -> ActionType -> ActionType
max :: ActionType -> ActionType -> ActionType
$cmin :: ActionType -> ActionType -> ActionType
min :: ActionType -> ActionType -> ActionType
Ord,ReadPrec [ActionType]
ReadPrec ActionType
Int -> ReadS ActionType
ReadS [ActionType]
(Int -> ReadS ActionType)
-> ReadS [ActionType]
-> ReadPrec ActionType
-> ReadPrec [ActionType]
-> Read ActionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ActionType
readsPrec :: Int -> ReadS ActionType
$creadList :: ReadS [ActionType]
readList :: ReadS [ActionType]
$creadPrec :: ReadPrec ActionType
readPrec :: ReadPrec ActionType
$creadListPrec :: ReadPrec [ActionType]
readListPrec :: ReadPrec [ActionType]
Read,(forall x. ActionType -> Rep ActionType x)
-> (forall x. Rep ActionType x -> ActionType) -> Generic ActionType
forall x. Rep ActionType x -> ActionType
forall x. ActionType -> Rep ActionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionType -> Rep ActionType x
from :: forall x. ActionType -> Rep ActionType x
$cto :: forall x. Rep ActionType x -> ActionType
to :: forall x. Rep ActionType x -> ActionType
Generic)

-- ^ comment of the transaction in the accounts
data TxnComment = PayInt [BondName]
                | PayYield BondName 
                | PayPrin [BondName] 
                | PayGroupPrin [BondName]
                | PayGroupInt [BondName]
                | WriteOff BondName Balance
                | FundWith BondName Balance
                | PayPrinResidual [BondName] 
                | PayFee FeeName
                | SeqPayFee [FeeName] 
                | PayFeeYield FeeName
                | Transfer AccName AccName 
                | TransferBy AccName AccName Limit
                | BookLedgerBy BookDirection String
                | PoolInflow (Maybe [PoolId]) PoolSource
                | LiquidationProceeds [PoolId]
                | LiquidationSupport String
                | LiquidationDraw
                | LiquidationRepay String
                | LiquidationSupportInt Balance Balance
                | BankInt
                | SupportDraw
                | Empty 
                | Tag String
                | UsingDS DealStats
                | SwapAccrue
                | SwapInSettle String
                | SwapOutSettle String
                | PurchaseAsset String Balance
                | IssuanceProceeds String
                | TxnDirection BookDirection
                | TxnComments [TxnComment]
                deriving (TxnComment -> TxnComment -> Bool
(TxnComment -> TxnComment -> Bool)
-> (TxnComment -> TxnComment -> Bool) -> Eq TxnComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxnComment -> TxnComment -> Bool
== :: TxnComment -> TxnComment -> Bool
$c/= :: TxnComment -> TxnComment -> Bool
/= :: TxnComment -> TxnComment -> Bool
Eq, Int -> TxnComment -> ShowS
[TxnComment] -> ShowS
TxnComment -> [Char]
(Int -> TxnComment -> ShowS)
-> (TxnComment -> [Char])
-> ([TxnComment] -> ShowS)
-> Show TxnComment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxnComment -> ShowS
showsPrec :: Int -> TxnComment -> ShowS
$cshow :: TxnComment -> [Char]
show :: TxnComment -> [Char]
$cshowList :: [TxnComment] -> ShowS
showList :: [TxnComment] -> ShowS
Show, Eq TxnComment
Eq TxnComment =>
(TxnComment -> TxnComment -> Ordering)
-> (TxnComment -> TxnComment -> Bool)
-> (TxnComment -> TxnComment -> Bool)
-> (TxnComment -> TxnComment -> Bool)
-> (TxnComment -> TxnComment -> Bool)
-> (TxnComment -> TxnComment -> TxnComment)
-> (TxnComment -> TxnComment -> TxnComment)
-> Ord TxnComment
TxnComment -> TxnComment -> Bool
TxnComment -> TxnComment -> Ordering
TxnComment -> TxnComment -> TxnComment
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 :: TxnComment -> TxnComment -> Ordering
compare :: TxnComment -> TxnComment -> Ordering
$c< :: TxnComment -> TxnComment -> Bool
< :: TxnComment -> TxnComment -> Bool
$c<= :: TxnComment -> TxnComment -> Bool
<= :: TxnComment -> TxnComment -> Bool
$c> :: TxnComment -> TxnComment -> Bool
> :: TxnComment -> TxnComment -> Bool
$c>= :: TxnComment -> TxnComment -> Bool
>= :: TxnComment -> TxnComment -> Bool
$cmax :: TxnComment -> TxnComment -> TxnComment
max :: TxnComment -> TxnComment -> TxnComment
$cmin :: TxnComment -> TxnComment -> TxnComment
min :: TxnComment -> TxnComment -> TxnComment
Ord ,ReadPrec [TxnComment]
ReadPrec TxnComment
Int -> ReadS TxnComment
ReadS [TxnComment]
(Int -> ReadS TxnComment)
-> ReadS [TxnComment]
-> ReadPrec TxnComment
-> ReadPrec [TxnComment]
-> Read TxnComment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TxnComment
readsPrec :: Int -> ReadS TxnComment
$creadList :: ReadS [TxnComment]
readList :: ReadS [TxnComment]
$creadPrec :: ReadPrec TxnComment
readPrec :: ReadPrec TxnComment
$creadListPrec :: ReadPrec [TxnComment]
readListPrec :: ReadPrec [TxnComment]
Read, (forall x. TxnComment -> Rep TxnComment x)
-> (forall x. Rep TxnComment x -> TxnComment) -> Generic TxnComment
forall x. Rep TxnComment x -> TxnComment
forall x. TxnComment -> Rep TxnComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxnComment -> Rep TxnComment x
from :: forall x. TxnComment -> Rep TxnComment x
$cto :: forall x. Rep TxnComment x -> TxnComment
to :: forall x. Rep TxnComment x -> TxnComment
Generic)

-- ^ transaction record in each entity
data Txn = BondTxn Date Balance Interest Principal IRate Cash DueInt DueIoI (Maybe Float) TxnComment     -- ^ bond transaction record for interest and principal 
         | AccTxn Date Balance Amount TxnComment                                                         -- ^ account transaction record 
         | ExpTxn Date Balance Amount Balance TxnComment                                                 -- ^ expense transaction record
         | SupportTxn Date (Maybe Balance) Balance DueInt DuePremium Cash TxnComment                     -- ^ liquidity provider transaction record
         | IrsTxn Date Balance Amount IRate IRate Balance TxnComment                                     -- ^ interest swap transaction record
         | EntryTxn Date Balance Amount TxnComment                                                       -- ^ ledger book entry
         | TrgTxn Date Bool TxnComment
         deriving (Int -> Txn -> ShowS
[Txn] -> ShowS
Txn -> [Char]
(Int -> Txn -> ShowS)
-> (Txn -> [Char]) -> ([Txn] -> ShowS) -> Show Txn
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Txn -> ShowS
showsPrec :: Int -> Txn -> ShowS
$cshow :: Txn -> [Char]
show :: Txn -> [Char]
$cshowList :: [Txn] -> ShowS
showList :: [Txn] -> ShowS
Show, (forall x. Txn -> Rep Txn x)
-> (forall x. Rep Txn x -> Txn) -> Generic Txn
forall x. Rep Txn x -> Txn
forall x. Txn -> Rep Txn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Txn -> Rep Txn x
from :: forall x. Txn -> Rep Txn x
$cto :: forall x. Rep Txn x -> Txn
to :: forall x. Rep Txn x -> Txn
Generic, Txn -> Txn -> Bool
(Txn -> Txn -> Bool) -> (Txn -> Txn -> Bool) -> Eq Txn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Txn -> Txn -> Bool
== :: Txn -> Txn -> Bool
$c/= :: Txn -> Txn -> Bool
/= :: Txn -> Txn -> Bool
Eq, ReadPrec [Txn]
ReadPrec Txn
Int -> ReadS Txn
ReadS [Txn]
(Int -> ReadS Txn)
-> ReadS [Txn] -> ReadPrec Txn -> ReadPrec [Txn] -> Read Txn
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Txn
readsPrec :: Int -> ReadS Txn
$creadList :: ReadS [Txn]
readList :: ReadS [Txn]
$creadPrec :: ReadPrec Txn
readPrec :: ReadPrec Txn
$creadListPrec :: ReadPrec [Txn]
readListPrec :: ReadPrec [Txn]
Read)


data DealStatFields = PoolCollectedPeriod
                    | BondPaidPeriod
                    deriving ((forall x. DealStatFields -> Rep DealStatFields x)
-> (forall x. Rep DealStatFields x -> DealStatFields)
-> Generic DealStatFields
forall x. Rep DealStatFields x -> DealStatFields
forall x. DealStatFields -> Rep DealStatFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DealStatFields -> Rep DealStatFields x
from :: forall x. DealStatFields -> Rep DealStatFields x
$cto :: forall x. Rep DealStatFields x -> DealStatFields
to :: forall x. Rep DealStatFields x -> DealStatFields
Generic, DealStatFields -> DealStatFields -> Bool
(DealStatFields -> DealStatFields -> Bool)
-> (DealStatFields -> DealStatFields -> Bool) -> Eq DealStatFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DealStatFields -> DealStatFields -> Bool
== :: DealStatFields -> DealStatFields -> Bool
$c/= :: DealStatFields -> DealStatFields -> Bool
/= :: DealStatFields -> DealStatFields -> Bool
Eq, Eq DealStatFields
Eq DealStatFields =>
(DealStatFields -> DealStatFields -> Ordering)
-> (DealStatFields -> DealStatFields -> Bool)
-> (DealStatFields -> DealStatFields -> Bool)
-> (DealStatFields -> DealStatFields -> Bool)
-> (DealStatFields -> DealStatFields -> Bool)
-> (DealStatFields -> DealStatFields -> DealStatFields)
-> (DealStatFields -> DealStatFields -> DealStatFields)
-> Ord DealStatFields
DealStatFields -> DealStatFields -> Bool
DealStatFields -> DealStatFields -> Ordering
DealStatFields -> DealStatFields -> DealStatFields
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 :: DealStatFields -> DealStatFields -> Ordering
compare :: DealStatFields -> DealStatFields -> Ordering
$c< :: DealStatFields -> DealStatFields -> Bool
< :: DealStatFields -> DealStatFields -> Bool
$c<= :: DealStatFields -> DealStatFields -> Bool
<= :: DealStatFields -> DealStatFields -> Bool
$c> :: DealStatFields -> DealStatFields -> Bool
> :: DealStatFields -> DealStatFields -> Bool
$c>= :: DealStatFields -> DealStatFields -> Bool
>= :: DealStatFields -> DealStatFields -> Bool
$cmax :: DealStatFields -> DealStatFields -> DealStatFields
max :: DealStatFields -> DealStatFields -> DealStatFields
$cmin :: DealStatFields -> DealStatFields -> DealStatFields
min :: DealStatFields -> DealStatFields -> DealStatFields
Ord, Int -> DealStatFields -> ShowS
[DealStatFields] -> ShowS
DealStatFields -> [Char]
(Int -> DealStatFields -> ShowS)
-> (DealStatFields -> [Char])
-> ([DealStatFields] -> ShowS)
-> Show DealStatFields
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DealStatFields -> ShowS
showsPrec :: Int -> DealStatFields -> ShowS
$cshow :: DealStatFields -> [Char]
show :: DealStatFields -> [Char]
$cshowList :: [DealStatFields] -> ShowS
showList :: [DealStatFields] -> ShowS
Show, ReadPrec [DealStatFields]
ReadPrec DealStatFields
Int -> ReadS DealStatFields
ReadS [DealStatFields]
(Int -> ReadS DealStatFields)
-> ReadS [DealStatFields]
-> ReadPrec DealStatFields
-> ReadPrec [DealStatFields]
-> Read DealStatFields
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DealStatFields
readsPrec :: Int -> ReadS DealStatFields
$creadList :: ReadS [DealStatFields]
readList :: ReadS [DealStatFields]
$creadPrec :: ReadPrec DealStatFields
readPrec :: ReadPrec DealStatFields
$creadListPrec :: ReadPrec [DealStatFields]
readListPrec :: ReadPrec [DealStatFields]
Read)

-- ^ different types of deal stats
data DealStats = CurrentBondBalance
               | CurrentPoolBalance (Maybe [PoolId])
               | CurrentPoolBegBalance (Maybe [PoolId])
               | CurrentPoolDefaultedBalance
               | CumulativePoolDefaultedBalance (Maybe [PoolId])  -- ^ Depreciated, use PoolCumCollection
               | CumulativePoolRecoveriesBalance (Maybe [PoolId]) -- ^ Depreciated, use PoolCumCollection
               | CumulativeNetLoss (Maybe [PoolId])
               | OriginalBondBalance
               | OriginalBondBalanceOf [BondName]
               | BondTotalFunding [BondName]
               | OriginalPoolBalance (Maybe [PoolId])
               | DealIssuanceBalance (Maybe [PoolId])
               | UseCustomData String
               | PoolCumCollection [PoolSource] (Maybe [PoolId])
               | PoolCumCollectionTill Int [PoolSource] (Maybe [PoolId])
               | PoolCurCollection [PoolSource] (Maybe [PoolId])
               | PoolCollectionStats Int [PoolSource] (Maybe [PoolId])
	       | PoolWaSpread (Maybe [PoolId])
               | AllAccBalance
               | AccBalance [AccName]
               | LedgerBalance [String]
               | LedgerBalanceBy BookDirection [String]
               | LedgerTxnAmt [String] (Maybe TxnComment)
               | ReserveBalance [AccName] 
               | ReserveGap [AccName]
               | ReserveExcess [AccName] 
               | ReserveGapAt Date [AccName] 
               | ReserveExcessAt Date [AccName] 
               | FutureCurrentPoolBalance (Maybe [PoolId])
               | FutureCurrentSchedulePoolBalance (Maybe [PoolId])
               | FutureCurrentSchedulePoolBegBalance (Maybe [PoolId])
               | PoolScheduleCfPv PricingMethod (Maybe [PoolId])
               | FuturePoolScheduleCfPv Date PricingMethod (Maybe [PoolId])
               | FutureWaCurrentPoolBalance Date Date (Maybe [PoolId])
               | FutureCurrentPoolBegBalance (Maybe [PoolId])
               | FutureCurrentBondBalance Date
               | CurrentBondBalanceOf [BondName]
               | BondIntPaidAt Date BondName
               | BondsIntPaidAt Date [BondName]
               | BondPrinPaidAt Date BondName
               | BondsPrinPaidAt Date [BondName]
               | BondBalanceTarget [BondName]
               | BondBalanceGap BondName
               | BondBalanceGapAt Date BondName
               | BondDuePrin [BondName]
               | BondReturn BondName Balance [TsPoint Amount]
               | FeePaidAmt [FeeName]
               | FeeTxnAmt [FeeName] (Maybe TxnComment)
               | BondTxnAmt [BondName] (Maybe TxnComment)
               | AccTxnAmt  [AccName] (Maybe TxnComment)
               | FeeTxnAmtBy Date [FeeName] (Maybe TxnComment)
               | BondTxnAmtBy Date [BondName] (Maybe TxnComment)
               | AccTxnAmtBy Date [AccName] (Maybe TxnComment)
               | FeesPaidAt Date [FeeName] 
               | CurrentDueBondInt [BondName]
               | CurrentDueBondIntAt Int [BondName]
               | CurrentDueBondIntOverInt [BondName]
               | CurrentDueBondIntOverIntAt Int [BondName]
               | CurrentDueBondIntTotal [BondName]
               | CurrentDueBondIntTotalAt Int [BondName]
               | CurrentDueFee [FeeName]
               | LastBondIntPaid [BondName]
               | LastBondPrinPaid [BondName]
               | LastFeePaid [FeeName]
               | LiqCredit [String]
               | LiqBalance [String]
               | RateCapNet String
               | RateSwapNet String
               | BondBalanceHistory Date Date
               | PoolCollectionHistory PoolSource Date Date (Maybe [PoolId])
               | UnderlyingBondBalance (Maybe [BondName])
               | WeightedAvgCurrentPoolBalance Date Date (Maybe [PoolId])
               | WeightedAvgCurrentBondBalance Date Date [BondName]
               | WeightedAvgOriginalPoolBalance Date Date (Maybe [PoolId])
               | WeightedAvgOriginalBondBalance Date Date [BondName]
               | CustomData String Date
               | DealStatBalance DealStatFields
               -- analytical query
               | AmountRequiredForTargetIRR Double BondName 
               -- integer type
               | CurrentPoolBorrowerNum (Maybe [PoolId])
               | FutureCurrentPoolBorrowerNum Date (Maybe [PoolId])
               | ProjCollectPeriodNum
               | MonthsTillMaturity BondName
               | DealStatInt DealStatFields
               -- boolean type
               | TestRate DealStats Cmp Micro
               | TestAny Bool [DealStats]
               | TestAll Bool [DealStats]
               | TestNot DealStats
               | IsDealStatus DealStatus
               | IsMostSenior BondName [BondName]
               | IsPaidOff [BondName]
               | IsFeePaidOff [String]
               | IsLiqSupportPaidOff [String]
               | IsRateSwapPaidOff [String]
               | IsOutstanding [BondName]
               | HasPassedMaturity [BondName]
               | TriggersStatus DealCycle String
               | DealStatBool DealStatFields
               -- rate type
               | PoolWaRate (Maybe PoolId)
               | BondRate BondName
               | CumulativeNetLossRatio (Maybe [PoolId])
               | FutureCurrentBondFactor Date
               | FutureCurrentPoolFactor Date (Maybe [PoolId])
               | BondFactor
               | BondFactorOf BondName
               | CumulativePoolDefaultedRate (Maybe [PoolId])
               | CumulativePoolDefaultedRateTill Int (Maybe [PoolId])
               | PoolFactor (Maybe [PoolId])
               | BondWaRate [BondName]
               | DealStatRate DealStatFields
               -- Compond type
               | Factor DealStats Rational
               | Multiply [DealStats]
               | Max [DealStats]
               | Min [DealStats]
               | Sum [DealStats]
               | Substract [DealStats]
               | Subtract [DealStats]
               | Excess [DealStats]
               | Avg [DealStats]
               | AvgRatio [DealStats]
               | Divide DealStats DealStats
               | DivideRatio DealStats DealStats
               | Constant Rational
               | FloorAndCap DealStats DealStats DealStats
               | FloorWith DealStats DealStats
               | FloorWithZero DealStats
               | CapWith DealStats DealStats
               | Abs DealStats
               | Round DealStats (RoundingBy Rational)
               deriving (Int -> DealStats -> ShowS
[DealStats] -> ShowS
DealStats -> [Char]
(Int -> DealStats -> ShowS)
-> (DealStats -> [Char])
-> ([DealStats] -> ShowS)
-> Show DealStats
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DealStats -> ShowS
showsPrec :: Int -> DealStats -> ShowS
$cshow :: DealStats -> [Char]
show :: DealStats -> [Char]
$cshowList :: [DealStats] -> ShowS
showList :: [DealStats] -> ShowS
Show,DealStats -> DealStats -> Bool
(DealStats -> DealStats -> Bool)
-> (DealStats -> DealStats -> Bool) -> Eq DealStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DealStats -> DealStats -> Bool
== :: DealStats -> DealStats -> Bool
$c/= :: DealStats -> DealStats -> Bool
/= :: DealStats -> DealStats -> Bool
Eq,Eq DealStats
Eq DealStats =>
(DealStats -> DealStats -> Ordering)
-> (DealStats -> DealStats -> Bool)
-> (DealStats -> DealStats -> Bool)
-> (DealStats -> DealStats -> Bool)
-> (DealStats -> DealStats -> Bool)
-> (DealStats -> DealStats -> DealStats)
-> (DealStats -> DealStats -> DealStats)
-> Ord DealStats
DealStats -> DealStats -> Bool
DealStats -> DealStats -> Ordering
DealStats -> DealStats -> DealStats
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 :: DealStats -> DealStats -> Ordering
compare :: DealStats -> DealStats -> Ordering
$c< :: DealStats -> DealStats -> Bool
< :: DealStats -> DealStats -> Bool
$c<= :: DealStats -> DealStats -> Bool
<= :: DealStats -> DealStats -> Bool
$c> :: DealStats -> DealStats -> Bool
> :: DealStats -> DealStats -> Bool
$c>= :: DealStats -> DealStats -> Bool
>= :: DealStats -> DealStats -> Bool
$cmax :: DealStats -> DealStats -> DealStats
max :: DealStats -> DealStats -> DealStats
$cmin :: DealStats -> DealStats -> DealStats
min :: DealStats -> DealStats -> DealStats
Ord,ReadPrec [DealStats]
ReadPrec DealStats
Int -> ReadS DealStats
ReadS [DealStats]
(Int -> ReadS DealStats)
-> ReadS [DealStats]
-> ReadPrec DealStats
-> ReadPrec [DealStats]
-> Read DealStats
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DealStats
readsPrec :: Int -> ReadS DealStats
$creadList :: ReadS [DealStats]
readList :: ReadS [DealStats]
$creadPrec :: ReadPrec DealStats
readPrec :: ReadPrec DealStats
$creadListPrec :: ReadPrec [DealStats]
readListPrec :: ReadPrec [DealStats]
Read,(forall x. DealStats -> Rep DealStats x)
-> (forall x. Rep DealStats x -> DealStats) -> Generic DealStats
forall x. Rep DealStats x -> DealStats
forall x. DealStats -> Rep DealStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DealStats -> Rep DealStats x
from :: forall x. DealStats -> Rep DealStats x
$cto :: forall x. Rep DealStats x -> DealStats
to :: forall x. Rep DealStats x -> DealStats
Generic)

preHasTrigger :: Pre -> [(DealCycle,String)]
preHasTrigger :: Pre -> [(DealCycle, [Char])]
preHasTrigger (IfBool (TriggersStatus DealCycle
dc [Char]
tName) Bool
_) = [(DealCycle
dc,[Char]
tName)]
preHasTrigger (Any [Pre]
ps) = [[(DealCycle, [Char])]] -> [(DealCycle, [Char])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(DealCycle, [Char])]] -> [(DealCycle, [Char])])
-> [[(DealCycle, [Char])]] -> [(DealCycle, [Char])]
forall a b. (a -> b) -> a -> b
$ Pre -> [(DealCycle, [Char])]
preHasTrigger (Pre -> [(DealCycle, [Char])]) -> [Pre] -> [[(DealCycle, [Char])]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pre]
ps
preHasTrigger (All [Pre]
ps) = [[(DealCycle, [Char])]] -> [(DealCycle, [Char])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(DealCycle, [Char])]] -> [(DealCycle, [Char])])
-> [[(DealCycle, [Char])]] -> [(DealCycle, [Char])]
forall a b. (a -> b) -> a -> b
$ Pre -> [(DealCycle, [Char])]
preHasTrigger (Pre -> [(DealCycle, [Char])]) -> [Pre] -> [[(DealCycle, [Char])]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pre]
ps
preHasTrigger Pre
_ = []


data Limit = DuePct Rate            -- ^ up to % of total amount due
           | DueCapAmt Balance      -- ^ up to $ amount 
           | KeepBalAmt DealStats   -- ^ pay till a certain amount remains in an account
           | DS DealStats           -- ^ transfer with limit described by a `DealStats`
           -- | ClearLedger BookDirection String     -- ^ when transfer, clear the ledger by transfer amount
           -- | ClearLedgerBySeq BookDirection [String]  -- ^ clear a direction to a sequence of ledgers
           -- | BookLedger String      -- ^ when transfer, book the ledger by the transfer amount
           | RemainBalPct Rate      -- ^ pay till remain balance equals to a percentage of `stats`
           | TillTarget             -- ^ transfer amount which make target account up reach reserve balanace
           | TillSource             -- ^ transfer amount out till source account down back to reserve balance
           | Multiple Limit Float   -- ^ factor of a limit
           deriving (Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> [Char]
(Int -> Limit -> ShowS)
-> (Limit -> [Char]) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Limit -> ShowS
showsPrec :: Int -> Limit -> ShowS
$cshow :: Limit -> [Char]
show :: Limit -> [Char]
$cshowList :: [Limit] -> ShowS
showList :: [Limit] -> ShowS
Show,Eq Limit
Eq Limit =>
(Limit -> Limit -> Ordering)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Limit)
-> (Limit -> Limit -> Limit)
-> Ord Limit
Limit -> Limit -> Bool
Limit -> Limit -> Ordering
Limit -> Limit -> Limit
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 :: Limit -> Limit -> Ordering
compare :: Limit -> Limit -> Ordering
$c< :: Limit -> Limit -> Bool
< :: Limit -> Limit -> Bool
$c<= :: Limit -> Limit -> Bool
<= :: Limit -> Limit -> Bool
$c> :: Limit -> Limit -> Bool
> :: Limit -> Limit -> Bool
$c>= :: Limit -> Limit -> Bool
>= :: Limit -> Limit -> Bool
$cmax :: Limit -> Limit -> Limit
max :: Limit -> Limit -> Limit
$cmin :: Limit -> Limit -> Limit
min :: Limit -> Limit -> Limit
Ord,Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
/= :: Limit -> Limit -> Bool
Eq,ReadPrec [Limit]
ReadPrec Limit
Int -> ReadS Limit
ReadS [Limit]
(Int -> ReadS Limit)
-> ReadS [Limit]
-> ReadPrec Limit
-> ReadPrec [Limit]
-> Read Limit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Limit
readsPrec :: Int -> ReadS Limit
$creadList :: ReadS [Limit]
readList :: ReadS [Limit]
$creadPrec :: ReadPrec Limit
readPrec :: ReadPrec Limit
$creadListPrec :: ReadPrec [Limit]
readListPrec :: ReadPrec [Limit]
Read, (forall x. Limit -> Rep Limit x)
-> (forall x. Rep Limit x -> Limit) -> Generic Limit
forall x. Rep Limit x -> Limit
forall x. Limit -> Rep Limit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Limit -> Rep Limit x
from :: forall x. Limit -> Rep Limit x
$cto :: forall x. Rep Limit x -> Limit
to :: forall x. Rep Limit x -> Limit
Generic)

data HowToPay = ByProRata
              | BySequential
              deriving (Int -> HowToPay -> ShowS
[HowToPay] -> ShowS
HowToPay -> [Char]
(Int -> HowToPay -> ShowS)
-> (HowToPay -> [Char]) -> ([HowToPay] -> ShowS) -> Show HowToPay
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HowToPay -> ShowS
showsPrec :: Int -> HowToPay -> ShowS
$cshow :: HowToPay -> [Char]
show :: HowToPay -> [Char]
$cshowList :: [HowToPay] -> ShowS
showList :: [HowToPay] -> ShowS
Show,Eq HowToPay
Eq HowToPay =>
(HowToPay -> HowToPay -> Ordering)
-> (HowToPay -> HowToPay -> Bool)
-> (HowToPay -> HowToPay -> Bool)
-> (HowToPay -> HowToPay -> Bool)
-> (HowToPay -> HowToPay -> Bool)
-> (HowToPay -> HowToPay -> HowToPay)
-> (HowToPay -> HowToPay -> HowToPay)
-> Ord HowToPay
HowToPay -> HowToPay -> Bool
HowToPay -> HowToPay -> Ordering
HowToPay -> HowToPay -> HowToPay
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 :: HowToPay -> HowToPay -> Ordering
compare :: HowToPay -> HowToPay -> Ordering
$c< :: HowToPay -> HowToPay -> Bool
< :: HowToPay -> HowToPay -> Bool
$c<= :: HowToPay -> HowToPay -> Bool
<= :: HowToPay -> HowToPay -> Bool
$c> :: HowToPay -> HowToPay -> Bool
> :: HowToPay -> HowToPay -> Bool
$c>= :: HowToPay -> HowToPay -> Bool
>= :: HowToPay -> HowToPay -> Bool
$cmax :: HowToPay -> HowToPay -> HowToPay
max :: HowToPay -> HowToPay -> HowToPay
$cmin :: HowToPay -> HowToPay -> HowToPay
min :: HowToPay -> HowToPay -> HowToPay
Ord,HowToPay -> HowToPay -> Bool
(HowToPay -> HowToPay -> Bool)
-> (HowToPay -> HowToPay -> Bool) -> Eq HowToPay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HowToPay -> HowToPay -> Bool
== :: HowToPay -> HowToPay -> Bool
$c/= :: HowToPay -> HowToPay -> Bool
/= :: HowToPay -> HowToPay -> Bool
Eq,ReadPrec [HowToPay]
ReadPrec HowToPay
Int -> ReadS HowToPay
ReadS [HowToPay]
(Int -> ReadS HowToPay)
-> ReadS [HowToPay]
-> ReadPrec HowToPay
-> ReadPrec [HowToPay]
-> Read HowToPay
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HowToPay
readsPrec :: Int -> ReadS HowToPay
$creadList :: ReadS [HowToPay]
readList :: ReadS [HowToPay]
$creadPrec :: ReadPrec HowToPay
readPrec :: ReadPrec HowToPay
$creadListPrec :: ReadPrec [HowToPay]
readListPrec :: ReadPrec [HowToPay]
Read, (forall x. HowToPay -> Rep HowToPay x)
-> (forall x. Rep HowToPay x -> HowToPay) -> Generic HowToPay
forall x. Rep HowToPay x -> HowToPay
forall x. HowToPay -> Rep HowToPay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HowToPay -> Rep HowToPay x
from :: forall x. HowToPay -> Rep HowToPay x
$cto :: forall x. Rep HowToPay x -> HowToPay
to :: forall x. Rep HowToPay x -> HowToPay
Generic)

type BookItems = [BookItem]

data BookItem = Item String Balance 
              | ParentItem String BookItems
              deriving (Int -> BookItem -> ShowS
[BookItem] -> ShowS
BookItem -> [Char]
(Int -> BookItem -> ShowS)
-> (BookItem -> [Char]) -> ([BookItem] -> ShowS) -> Show BookItem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BookItem -> ShowS
showsPrec :: Int -> BookItem -> ShowS
$cshow :: BookItem -> [Char]
show :: BookItem -> [Char]
$cshowList :: [BookItem] -> ShowS
showList :: [BookItem] -> ShowS
Show,ReadPrec [BookItem]
ReadPrec BookItem
Int -> ReadS BookItem
ReadS [BookItem]
(Int -> ReadS BookItem)
-> ReadS [BookItem]
-> ReadPrec BookItem
-> ReadPrec [BookItem]
-> Read BookItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BookItem
readsPrec :: Int -> ReadS BookItem
$creadList :: ReadS [BookItem]
readList :: ReadS [BookItem]
$creadPrec :: ReadPrec BookItem
readPrec :: ReadPrec BookItem
$creadListPrec :: ReadPrec [BookItem]
readListPrec :: ReadPrec [BookItem]
Read,(forall x. BookItem -> Rep BookItem x)
-> (forall x. Rep BookItem x -> BookItem) -> Generic BookItem
forall x. Rep BookItem x -> BookItem
forall x. BookItem -> Rep BookItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BookItem -> Rep BookItem x
from :: forall x. BookItem -> Rep BookItem x
$cto :: forall x. Rep BookItem x -> BookItem
to :: forall x. Rep BookItem x -> BookItem
Generic,BookItem -> BookItem -> Bool
(BookItem -> BookItem -> Bool)
-> (BookItem -> BookItem -> Bool) -> Eq BookItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BookItem -> BookItem -> Bool
== :: BookItem -> BookItem -> Bool
$c/= :: BookItem -> BookItem -> Bool
/= :: BookItem -> BookItem -> Bool
Eq)

data BalanceSheetReport = BalanceSheetReport {
                            BalanceSheetReport -> BookItem
asset :: BookItem
                            ,BalanceSheetReport -> BookItem
liability :: BookItem
                            ,BalanceSheetReport -> BookItem
equity :: BookItem
                            ,BalanceSheetReport -> Day
reportDate :: Date}         -- ^ snapshot date of the balance sheet
                            deriving (Int -> BalanceSheetReport -> ShowS
[BalanceSheetReport] -> ShowS
BalanceSheetReport -> [Char]
(Int -> BalanceSheetReport -> ShowS)
-> (BalanceSheetReport -> [Char])
-> ([BalanceSheetReport] -> ShowS)
-> Show BalanceSheetReport
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalanceSheetReport -> ShowS
showsPrec :: Int -> BalanceSheetReport -> ShowS
$cshow :: BalanceSheetReport -> [Char]
show :: BalanceSheetReport -> [Char]
$cshowList :: [BalanceSheetReport] -> ShowS
showList :: [BalanceSheetReport] -> ShowS
Show,ReadPrec [BalanceSheetReport]
ReadPrec BalanceSheetReport
Int -> ReadS BalanceSheetReport
ReadS [BalanceSheetReport]
(Int -> ReadS BalanceSheetReport)
-> ReadS [BalanceSheetReport]
-> ReadPrec BalanceSheetReport
-> ReadPrec [BalanceSheetReport]
-> Read BalanceSheetReport
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BalanceSheetReport
readsPrec :: Int -> ReadS BalanceSheetReport
$creadList :: ReadS [BalanceSheetReport]
readList :: ReadS [BalanceSheetReport]
$creadPrec :: ReadPrec BalanceSheetReport
readPrec :: ReadPrec BalanceSheetReport
$creadListPrec :: ReadPrec [BalanceSheetReport]
readListPrec :: ReadPrec [BalanceSheetReport]
Read,(forall x. BalanceSheetReport -> Rep BalanceSheetReport x)
-> (forall x. Rep BalanceSheetReport x -> BalanceSheetReport)
-> Generic BalanceSheetReport
forall x. Rep BalanceSheetReport x -> BalanceSheetReport
forall x. BalanceSheetReport -> Rep BalanceSheetReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BalanceSheetReport -> Rep BalanceSheetReport x
from :: forall x. BalanceSheetReport -> Rep BalanceSheetReport x
$cto :: forall x. Rep BalanceSheetReport x -> BalanceSheetReport
to :: forall x. Rep BalanceSheetReport x -> BalanceSheetReport
Generic,BalanceSheetReport -> BalanceSheetReport -> Bool
(BalanceSheetReport -> BalanceSheetReport -> Bool)
-> (BalanceSheetReport -> BalanceSheetReport -> Bool)
-> Eq BalanceSheetReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalanceSheetReport -> BalanceSheetReport -> Bool
== :: BalanceSheetReport -> BalanceSheetReport -> Bool
$c/= :: BalanceSheetReport -> BalanceSheetReport -> Bool
/= :: BalanceSheetReport -> BalanceSheetReport -> Bool
Eq)

data CashflowReport = CashflowReport {
                        CashflowReport -> BookItem
inflow :: BookItem
                        ,CashflowReport -> BookItem
outflow :: BookItem
                        ,CashflowReport -> BookItem
net ::  BookItem
                        ,CashflowReport -> Day
startDate :: Date 
                        ,CashflowReport -> Day
endDate :: Date }
                        deriving (Int -> CashflowReport -> ShowS
[CashflowReport] -> ShowS
CashflowReport -> [Char]
(Int -> CashflowReport -> ShowS)
-> (CashflowReport -> [Char])
-> ([CashflowReport] -> ShowS)
-> Show CashflowReport
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CashflowReport -> ShowS
showsPrec :: Int -> CashflowReport -> ShowS
$cshow :: CashflowReport -> [Char]
show :: CashflowReport -> [Char]
$cshowList :: [CashflowReport] -> ShowS
showList :: [CashflowReport] -> ShowS
Show,ReadPrec [CashflowReport]
ReadPrec CashflowReport
Int -> ReadS CashflowReport
ReadS [CashflowReport]
(Int -> ReadS CashflowReport)
-> ReadS [CashflowReport]
-> ReadPrec CashflowReport
-> ReadPrec [CashflowReport]
-> Read CashflowReport
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CashflowReport
readsPrec :: Int -> ReadS CashflowReport
$creadList :: ReadS [CashflowReport]
readList :: ReadS [CashflowReport]
$creadPrec :: ReadPrec CashflowReport
readPrec :: ReadPrec CashflowReport
$creadListPrec :: ReadPrec [CashflowReport]
readListPrec :: ReadPrec [CashflowReport]
Read,(forall x. CashflowReport -> Rep CashflowReport x)
-> (forall x. Rep CashflowReport x -> CashflowReport)
-> Generic CashflowReport
forall x. Rep CashflowReport x -> CashflowReport
forall x. CashflowReport -> Rep CashflowReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CashflowReport -> Rep CashflowReport x
from :: forall x. CashflowReport -> Rep CashflowReport x
$cto :: forall x. Rep CashflowReport x -> CashflowReport
to :: forall x. Rep CashflowReport x -> CashflowReport
Generic,CashflowReport -> CashflowReport -> Bool
(CashflowReport -> CashflowReport -> Bool)
-> (CashflowReport -> CashflowReport -> Bool) -> Eq CashflowReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CashflowReport -> CashflowReport -> Bool
== :: CashflowReport -> CashflowReport -> Bool
$c/= :: CashflowReport -> CashflowReport -> Bool
/= :: CashflowReport -> CashflowReport -> Bool
Eq)


data Threshold = Below
               | EqBelow
               | Above
               | EqAbove
               deriving (Int -> Threshold -> ShowS
[Threshold] -> ShowS
Threshold -> [Char]
(Int -> Threshold -> ShowS)
-> (Threshold -> [Char])
-> ([Threshold] -> ShowS)
-> Show Threshold
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Threshold -> ShowS
showsPrec :: Int -> Threshold -> ShowS
$cshow :: Threshold -> [Char]
show :: Threshold -> [Char]
$cshowList :: [Threshold] -> ShowS
showList :: [Threshold] -> ShowS
Show,Threshold -> Threshold -> Bool
(Threshold -> Threshold -> Bool)
-> (Threshold -> Threshold -> Bool) -> Eq Threshold
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Threshold -> Threshold -> Bool
== :: Threshold -> Threshold -> Bool
$c/= :: Threshold -> Threshold -> Bool
/= :: Threshold -> Threshold -> Bool
Eq,Eq Threshold
Eq Threshold =>
(Threshold -> Threshold -> Ordering)
-> (Threshold -> Threshold -> Bool)
-> (Threshold -> Threshold -> Bool)
-> (Threshold -> Threshold -> Bool)
-> (Threshold -> Threshold -> Bool)
-> (Threshold -> Threshold -> Threshold)
-> (Threshold -> Threshold -> Threshold)
-> Ord Threshold
Threshold -> Threshold -> Bool
Threshold -> Threshold -> Ordering
Threshold -> Threshold -> Threshold
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 :: Threshold -> Threshold -> Ordering
compare :: Threshold -> Threshold -> Ordering
$c< :: Threshold -> Threshold -> Bool
< :: Threshold -> Threshold -> Bool
$c<= :: Threshold -> Threshold -> Bool
<= :: Threshold -> Threshold -> Bool
$c> :: Threshold -> Threshold -> Bool
> :: Threshold -> Threshold -> Bool
$c>= :: Threshold -> Threshold -> Bool
>= :: Threshold -> Threshold -> Bool
$cmax :: Threshold -> Threshold -> Threshold
max :: Threshold -> Threshold -> Threshold
$cmin :: Threshold -> Threshold -> Threshold
min :: Threshold -> Threshold -> Threshold
Ord,ReadPrec [Threshold]
ReadPrec Threshold
Int -> ReadS Threshold
ReadS [Threshold]
(Int -> ReadS Threshold)
-> ReadS [Threshold]
-> ReadPrec Threshold
-> ReadPrec [Threshold]
-> Read Threshold
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Threshold
readsPrec :: Int -> ReadS Threshold
$creadList :: ReadS [Threshold]
readList :: ReadS [Threshold]
$creadPrec :: ReadPrec Threshold
readPrec :: ReadPrec Threshold
$creadListPrec :: ReadPrec [Threshold]
readListPrec :: ReadPrec [Threshold]
Read,(forall x. Threshold -> Rep Threshold x)
-> (forall x. Rep Threshold x -> Threshold) -> Generic Threshold
forall x. Rep Threshold x -> Threshold
forall x. Threshold -> Rep Threshold x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Threshold -> Rep Threshold x
from :: forall x. Threshold -> Rep Threshold x
$cto :: forall x. Rep Threshold x -> Threshold
to :: forall x. Rep Threshold x -> Threshold
Generic)

data SplitType = EqToLeft   -- if equal, the element belongs to left
               | EqToRight  -- if equal, the element belongs to right
               | EqToLeftKeepOne
               | EqToLeftKeepOnes
               deriving (Int -> SplitType -> ShowS
[SplitType] -> ShowS
SplitType -> [Char]
(Int -> SplitType -> ShowS)
-> (SplitType -> [Char])
-> ([SplitType] -> ShowS)
-> Show SplitType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SplitType -> ShowS
showsPrec :: Int -> SplitType -> ShowS
$cshow :: SplitType -> [Char]
show :: SplitType -> [Char]
$cshowList :: [SplitType] -> ShowS
showList :: [SplitType] -> ShowS
Show, SplitType -> SplitType -> Bool
(SplitType -> SplitType -> Bool)
-> (SplitType -> SplitType -> Bool) -> Eq SplitType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SplitType -> SplitType -> Bool
== :: SplitType -> SplitType -> Bool
$c/= :: SplitType -> SplitType -> Bool
/= :: SplitType -> SplitType -> Bool
Eq, (forall x. SplitType -> Rep SplitType x)
-> (forall x. Rep SplitType x -> SplitType) -> Generic SplitType
forall x. Rep SplitType x -> SplitType
forall x. SplitType -> Rep SplitType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SplitType -> Rep SplitType x
from :: forall x. SplitType -> Rep SplitType x
$cto :: forall x. Rep SplitType x -> SplitType
to :: forall x. Rep SplitType x -> SplitType
Generic)

-- ^ deal level cumulative statistics
data CutoffFields = IssuanceBalance              -- ^ pool issuance balance
                  | HistoryRecoveries            -- ^ cumulative recoveries
                  | HistoryInterest              -- ^ cumulative interest collected
                  | HistoryPrepayment            -- ^ cumulative prepayment collected
                  | HistoryPrepaymentPentalty    -- ^ cumulative prepayment collected
                  | HistoryPrincipal             -- ^ cumulative principal collected
                  | HistoryRental                -- ^ cumulative rental collected
                  | HistoryDefaults              -- ^ cumulative default balance
                  | HistoryDelinquency           -- ^ cumulative delinquency balance
                  | HistoryLoss                  -- ^ cumulative loss/write-off balance
                  | HistoryCash                  -- ^ cumulative cash
                  | HistoryFeePaid
                  | AccruedInterest              -- ^ accrued interest at closing
                  | RuntimeCurrentPoolBalance    -- ^ current pool balance
                  deriving (Int -> CutoffFields -> ShowS
[CutoffFields] -> ShowS
CutoffFields -> [Char]
(Int -> CutoffFields -> ShowS)
-> (CutoffFields -> [Char])
-> ([CutoffFields] -> ShowS)
-> Show CutoffFields
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CutoffFields -> ShowS
showsPrec :: Int -> CutoffFields -> ShowS
$cshow :: CutoffFields -> [Char]
show :: CutoffFields -> [Char]
$cshowList :: [CutoffFields] -> ShowS
showList :: [CutoffFields] -> ShowS
Show,Eq CutoffFields
Eq CutoffFields =>
(CutoffFields -> CutoffFields -> Ordering)
-> (CutoffFields -> CutoffFields -> Bool)
-> (CutoffFields -> CutoffFields -> Bool)
-> (CutoffFields -> CutoffFields -> Bool)
-> (CutoffFields -> CutoffFields -> Bool)
-> (CutoffFields -> CutoffFields -> CutoffFields)
-> (CutoffFields -> CutoffFields -> CutoffFields)
-> Ord CutoffFields
CutoffFields -> CutoffFields -> Bool
CutoffFields -> CutoffFields -> Ordering
CutoffFields -> CutoffFields -> CutoffFields
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 :: CutoffFields -> CutoffFields -> Ordering
compare :: CutoffFields -> CutoffFields -> Ordering
$c< :: CutoffFields -> CutoffFields -> Bool
< :: CutoffFields -> CutoffFields -> Bool
$c<= :: CutoffFields -> CutoffFields -> Bool
<= :: CutoffFields -> CutoffFields -> Bool
$c> :: CutoffFields -> CutoffFields -> Bool
> :: CutoffFields -> CutoffFields -> Bool
$c>= :: CutoffFields -> CutoffFields -> Bool
>= :: CutoffFields -> CutoffFields -> Bool
$cmax :: CutoffFields -> CutoffFields -> CutoffFields
max :: CutoffFields -> CutoffFields -> CutoffFields
$cmin :: CutoffFields -> CutoffFields -> CutoffFields
min :: CutoffFields -> CutoffFields -> CutoffFields
Ord,CutoffFields -> CutoffFields -> Bool
(CutoffFields -> CutoffFields -> Bool)
-> (CutoffFields -> CutoffFields -> Bool) -> Eq CutoffFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CutoffFields -> CutoffFields -> Bool
== :: CutoffFields -> CutoffFields -> Bool
$c/= :: CutoffFields -> CutoffFields -> Bool
/= :: CutoffFields -> CutoffFields -> Bool
Eq,ReadPrec [CutoffFields]
ReadPrec CutoffFields
Int -> ReadS CutoffFields
ReadS [CutoffFields]
(Int -> ReadS CutoffFields)
-> ReadS [CutoffFields]
-> ReadPrec CutoffFields
-> ReadPrec [CutoffFields]
-> Read CutoffFields
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CutoffFields
readsPrec :: Int -> ReadS CutoffFields
$creadList :: ReadS [CutoffFields]
readList :: ReadS [CutoffFields]
$creadPrec :: ReadPrec CutoffFields
readPrec :: ReadPrec CutoffFields
$creadListPrec :: ReadPrec [CutoffFields]
readListPrec :: ReadPrec [CutoffFields]
Read,(forall x. CutoffFields -> Rep CutoffFields x)
-> (forall x. Rep CutoffFields x -> CutoffFields)
-> Generic CutoffFields
forall x. Rep CutoffFields x -> CutoffFields
forall x. CutoffFields -> Rep CutoffFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CutoffFields -> Rep CutoffFields x
from :: forall x. CutoffFields -> Rep CutoffFields x
$cto :: forall x. Rep CutoffFields x -> CutoffFields
to :: forall x. Rep CutoffFields x -> CutoffFields
Generic,CutoffFields -> ()
(CutoffFields -> ()) -> NFData CutoffFields
forall a. (a -> ()) -> NFData a
$crnf :: CutoffFields -> ()
rnf :: CutoffFields -> ()
NFData)


data PriceResult = PriceResult Valuation PerFace WAL Duration Convexity AccruedInterest [Txn]
         | AssetPrice Valuation WAL Duration Convexity AccruedInterest
         | OASResult PriceResult [Valuation] Spread  
         | ZSpread Spread 
         | IrrResult IRR [Txn]
         deriving (Int -> PriceResult -> ShowS
[PriceResult] -> ShowS
PriceResult -> [Char]
(Int -> PriceResult -> ShowS)
-> (PriceResult -> [Char])
-> ([PriceResult] -> ShowS)
-> Show PriceResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PriceResult -> ShowS
showsPrec :: Int -> PriceResult -> ShowS
$cshow :: PriceResult -> [Char]
show :: PriceResult -> [Char]
$cshowList :: [PriceResult] -> ShowS
showList :: [PriceResult] -> ShowS
Show, PriceResult -> PriceResult -> Bool
(PriceResult -> PriceResult -> Bool)
-> (PriceResult -> PriceResult -> Bool) -> Eq PriceResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PriceResult -> PriceResult -> Bool
== :: PriceResult -> PriceResult -> Bool
$c/= :: PriceResult -> PriceResult -> Bool
/= :: PriceResult -> PriceResult -> Bool
Eq, (forall x. PriceResult -> Rep PriceResult x)
-> (forall x. Rep PriceResult x -> PriceResult)
-> Generic PriceResult
forall x. Rep PriceResult x -> PriceResult
forall x. PriceResult -> Rep PriceResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PriceResult -> Rep PriceResult x
from :: forall x. PriceResult -> Rep PriceResult x
$cto :: forall x. Rep PriceResult x -> PriceResult
to :: forall x. Rep PriceResult x -> PriceResult
Generic)

makePrisms ''PriceResult

getPriceValue :: PriceResult -> Balance
getPriceValue :: PriceResult -> Balance
getPriceValue (AssetPrice Balance
v Balance
_ IRate
_ IRate
_ Balance
_ ) = Balance
v
getPriceValue (PriceResult Balance
v IRate
_ Balance
_ IRate
_ IRate
_ Balance
_ [Txn]
_) = Balance
v
getPriceValue PriceResult
x = [Char] -> Balance
forall a. HasCallStack => [Char] -> a
error  ([Char] -> Balance) -> [Char] -> Balance
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to match with type when geting price value" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PriceResult -> [Char]
forall a. Show a => a -> [Char]
show PriceResult
x


getValuation :: PriceResult -> PerFace
getValuation :: PriceResult -> IRate
getValuation (PriceResult Balance
_ IRate
val Balance
_ IRate
_ IRate
_ Balance
_ [Txn]
_) = IRate
val
getValuation (OASResult PriceResult
pr [Balance]
_ IRate
_) = PriceResult -> IRate
getValuation PriceResult
pr
getValuation PriceResult
pr =  [Char] -> IRate
forall a. HasCallStack => [Char] -> a
error ([Char] -> IRate) -> [Char] -> IRate
forall a b. (a -> b) -> a -> b
$ [Char]
"not support for pricing result"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PriceResult -> [Char]
forall a. Show a => a -> [Char]
show PriceResult
pr


class Liable lb where 

  -- must implement
  isPaidOff :: lb -> Bool
  getCurBalance :: lb -> Balance
  getCurRate :: lb -> IRate
  getOriginBalance :: lb -> Balance
  getOriginDate :: lb -> Date
  getAccrueBegDate :: lb -> Date
  getDueInt :: lb -> Balance
  getDueIntAt :: lb -> Int -> Balance
  getDueIntOverInt :: lb -> Balance
  getDueIntOverIntAt :: lb -> Int -> Balance
  getTotalDueInt :: lb -> Balance
  getTotalDueIntAt :: lb -> Int -> Balance

  getOutstandingAmount :: lb -> Balance

  -- optional implement
  -- getTotalDue :: [lb] -> Balance
  -- getTotalDue lbs =  sum $ getDue <$> lbs


class Accruable ac where 
  accrue :: Date -> ac -> ac
  calcAccrual :: Date -> ac -> Balance

  -- buildAccrualAction :: ac -> Date -> Date -> [ActionOnDate]

-- class Resettable rs where 
--   reset :: Date -> rs -> rs
--   buildResetAction :: rs -> Date -> Date -> [Txn]

lookupTable :: Ord a => Table a b -> Direction -> (a -> Bool) -> Maybe b
lookupTable :: forall a b.
Ord a =>
Table a b -> Direction -> (a -> Bool) -> Maybe b
lookupTable (ThresholdTable [(a, b)]
rows) Direction
direction a -> Bool
lkUpFunc
  = case (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
lkUpFunc [a]
rs of 
      Maybe Int
Nothing -> Maybe b
forall a. Maybe a
Nothing
      Just Int
i -> b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ [b]
vs[b] -> Int -> b
forall a. HasCallStack => [a] -> Int -> a
!!Int
i  
    where 
        rs :: [a]
rs = case Direction
direction of 
                Direction
Up -> [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
rows
                Direction
Down -> ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
rows
        vs :: [b]
vs = case Direction
direction of 
                Direction
Up -> [b] -> [b]
forall a. [a] -> [a]
reverse ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
rows
                Direction
Down -> ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
rows

lookupIntervalTable :: Ord a => Table a b -> Direction -> (a -> Bool) -> Maybe ((a,b),(a,b))
lookupIntervalTable :: forall a b.
Ord a =>
Table a b -> Direction -> (a -> Bool) -> Maybe ((a, b), (a, b))
lookupIntervalTable (ThresholdTable [(a, b)]
rows) Direction
direction a -> Bool
lkUpFunc
  = case (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
lkUpFunc [a]
rs of 
      Maybe Int
Nothing -> Maybe ((a, b), (a, b))
forall a. Maybe a
Nothing
      Just Int
i -> if Int -> Int
forall a. Enum a => a -> a
succ Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(a, b)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
rows then 
                  Maybe ((a, b), (a, b))
forall a. Maybe a
Nothing
                else
                  ((a, b), (a, b)) -> Maybe ((a, b), (a, b))
forall a. a -> Maybe a
Just (((a, b), (a, b)) -> Maybe ((a, b), (a, b)))
-> ((a, b), (a, b)) -> Maybe ((a, b), (a, b))
forall a b. (a -> b) -> a -> b
$ ([(a, b)]
rows[(a, b)] -> Int -> (a, b)
forall a. HasCallStack => [a] -> Int -> a
!!Int
i, [(a, b)]
rows[(a, b)] -> Int -> (a, b)
forall a. HasCallStack => [a] -> Int -> a
!!(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) -- `debug` ("Find index"++ show i)
    where 
        rs :: [a]
rs = case Direction
direction of 
                Direction
Up -> [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
rows
                Direction
Down -> ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
rows


data RateAssumption = RateCurve Index Ts     -- ^ a rate curve ,which value of rates depends on time
                    | RateFlat Index IRate   -- ^ a rate constant
                    deriving (Int -> RateAssumption -> ShowS
[RateAssumption] -> ShowS
RateAssumption -> [Char]
(Int -> RateAssumption -> ShowS)
-> (RateAssumption -> [Char])
-> ([RateAssumption] -> ShowS)
-> Show RateAssumption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RateAssumption -> ShowS
showsPrec :: Int -> RateAssumption -> ShowS
$cshow :: RateAssumption -> [Char]
show :: RateAssumption -> [Char]
$cshowList :: [RateAssumption] -> ShowS
showList :: [RateAssumption] -> ShowS
Show, (forall x. RateAssumption -> Rep RateAssumption x)
-> (forall x. Rep RateAssumption x -> RateAssumption)
-> Generic RateAssumption
forall x. Rep RateAssumption x -> RateAssumption
forall x. RateAssumption -> Rep RateAssumption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RateAssumption -> Rep RateAssumption x
from :: forall x. RateAssumption -> Rep RateAssumption x
$cto :: forall x. Rep RateAssumption x -> RateAssumption
to :: forall x. Rep RateAssumption x -> RateAssumption
Generic)

data TimeHorizion = ByMonth
                  | ByYear
                  | ByQuarter

instance TimeSeries (TsPoint a) where 
    getDate :: TsPoint a -> Day
getDate (TsPoint Day
d a
a) = Day
d


$(deriveJSON defaultOptions ''DecimalRaw)
$(deriveJSON defaultOptions ''TsPoint)
$(deriveJSON defaultOptions ''PerPoint)
$(deriveJSON defaultOptions ''Ts)
$(deriveJSON defaultOptions ''Cmp)
$(deriveJSON defaultOptions ''PoolSource)
$(deriveJSON defaultOptions ''RoundingBy)
$(deriveJSON defaultOptions ''PoolId)



instance ToJSONKey PoolId where
  toJSONKey :: ToJSONKeyFunction PoolId
  toJSONKey :: ToJSONKeyFunction PoolId
toJSONKey = (PoolId -> Text) -> ToJSONKeyFunction PoolId
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ([Char] -> Text
T.pack ([Char] -> Text) -> (PoolId -> [Char]) -> PoolId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolId -> [Char]
forall a. Show a => a -> [Char]
show)

instance FromJSONKey PoolId where
  fromJSONKey :: FromJSONKeyFunction PoolId
fromJSONKey = (Text -> Parser PoolId) -> FromJSONKeyFunction PoolId
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser PoolId) -> FromJSONKeyFunction PoolId)
-> (Text -> Parser PoolId) -> FromJSONKeyFunction PoolId
forall a b. (a -> b) -> a -> b
$ \Text
t -> case [Char] -> Maybe PoolId
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
t) of
    Just PoolId
k -> PoolId -> Parser PoolId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PoolId
k
    Maybe PoolId
Nothing -> [Char] -> Parser PoolId
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid key: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">>"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (Text -> [Char]
T.unpack Text
t))

-- ^ different types of waterfall execution
data ActionWhen = EndOfPoolCollection             -- ^ waterfall executed at the end of pool collection
                | DistributionDay DealStatus      -- ^ waterfall executed depends on deal status
                | CleanUp                         -- ^ waterfall exectued upon a clean up call
                | OnClosingDay                    -- ^ waterfall executed on deal closing day
                | DefaultDistribution             -- ^ default waterfall executed
                | RampUp                          -- ^ ramp up
                | WithinTrigger String            -- ^ waterfall executed within a trigger  
                | CustomWaterfall String          -- ^ custom waterfall
                deriving (Int -> ActionWhen -> ShowS
[ActionWhen] -> ShowS
ActionWhen -> [Char]
(Int -> ActionWhen -> ShowS)
-> (ActionWhen -> [Char])
-> ([ActionWhen] -> ShowS)
-> Show ActionWhen
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionWhen -> ShowS
showsPrec :: Int -> ActionWhen -> ShowS
$cshow :: ActionWhen -> [Char]
show :: ActionWhen -> [Char]
$cshowList :: [ActionWhen] -> ShowS
showList :: [ActionWhen] -> ShowS
Show,Eq ActionWhen
Eq ActionWhen =>
(ActionWhen -> ActionWhen -> Ordering)
-> (ActionWhen -> ActionWhen -> Bool)
-> (ActionWhen -> ActionWhen -> Bool)
-> (ActionWhen -> ActionWhen -> Bool)
-> (ActionWhen -> ActionWhen -> Bool)
-> (ActionWhen -> ActionWhen -> ActionWhen)
-> (ActionWhen -> ActionWhen -> ActionWhen)
-> Ord ActionWhen
ActionWhen -> ActionWhen -> Bool
ActionWhen -> ActionWhen -> Ordering
ActionWhen -> ActionWhen -> ActionWhen
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 :: ActionWhen -> ActionWhen -> Ordering
compare :: ActionWhen -> ActionWhen -> Ordering
$c< :: ActionWhen -> ActionWhen -> Bool
< :: ActionWhen -> ActionWhen -> Bool
$c<= :: ActionWhen -> ActionWhen -> Bool
<= :: ActionWhen -> ActionWhen -> Bool
$c> :: ActionWhen -> ActionWhen -> Bool
> :: ActionWhen -> ActionWhen -> Bool
$c>= :: ActionWhen -> ActionWhen -> Bool
>= :: ActionWhen -> ActionWhen -> Bool
$cmax :: ActionWhen -> ActionWhen -> ActionWhen
max :: ActionWhen -> ActionWhen -> ActionWhen
$cmin :: ActionWhen -> ActionWhen -> ActionWhen
min :: ActionWhen -> ActionWhen -> ActionWhen
Ord,ActionWhen -> ActionWhen -> Bool
(ActionWhen -> ActionWhen -> Bool)
-> (ActionWhen -> ActionWhen -> Bool) -> Eq ActionWhen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionWhen -> ActionWhen -> Bool
== :: ActionWhen -> ActionWhen -> Bool
$c/= :: ActionWhen -> ActionWhen -> Bool
/= :: ActionWhen -> ActionWhen -> Bool
Eq,(forall x. ActionWhen -> Rep ActionWhen x)
-> (forall x. Rep ActionWhen x -> ActionWhen) -> Generic ActionWhen
forall x. Rep ActionWhen x -> ActionWhen
forall x. ActionWhen -> Rep ActionWhen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionWhen -> Rep ActionWhen x
from :: forall x. ActionWhen -> Rep ActionWhen x
$cto :: forall x. Rep ActionWhen x -> ActionWhen
to :: forall x. Rep ActionWhen x -> ActionWhen
Generic,ReadPrec [ActionWhen]
ReadPrec ActionWhen
Int -> ReadS ActionWhen
ReadS [ActionWhen]
(Int -> ReadS ActionWhen)
-> ReadS [ActionWhen]
-> ReadPrec ActionWhen
-> ReadPrec [ActionWhen]
-> Read ActionWhen
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ActionWhen
readsPrec :: Int -> ReadS ActionWhen
$creadList :: ReadS [ActionWhen]
readList :: ReadS [ActionWhen]
$creadPrec :: ReadPrec ActionWhen
readPrec :: ReadPrec ActionWhen
$creadListPrec :: ReadPrec [ActionWhen]
readListPrec :: ReadPrec [ActionWhen]
Read)


data ResultComponent = CallAt Date                                          -- ^ the date when deal called
                     | DealStatusChangeTo Date DealStatus DealStatus String -- ^ record when & why status changed
                     | BondOutstanding String Balance Balance               -- ^ when deal ends,calculate oustanding principal balance 
                     | BondOutstandingInt String Balance Balance            -- ^ when deal ends,calculate oustanding interest due 
                     | InspectBal Date DealStats Balance                    -- ^ A bal value from inspection
                     | InspectInt Date DealStats Int                        -- ^ A int value from inspection
                     | InspectRate Date DealStats Micro                     -- ^ A rate value from inspection
                     | InspectBool Date DealStats Bool                      -- ^ A bool value from inspection
                     | RunningWaterfall Date ActionWhen                     -- ^ running waterfall at a date 
                     | FinancialReport StartDate EndDate BalanceSheetReport CashflowReport
                     | InspectWaterfall Date (Maybe String) [DealStats] [String]
                     | ErrorMsg String
                     | WarningMsg String
                     | EndRun (Maybe Date) String                             -- ^ end of run with a message
                     -- | SnapshotCashflow Date String CashFlowFrame
                     deriving (Int -> ResultComponent -> ShowS
[ResultComponent] -> ShowS
ResultComponent -> [Char]
(Int -> ResultComponent -> ShowS)
-> (ResultComponent -> [Char])
-> ([ResultComponent] -> ShowS)
-> Show ResultComponent
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResultComponent -> ShowS
showsPrec :: Int -> ResultComponent -> ShowS
$cshow :: ResultComponent -> [Char]
show :: ResultComponent -> [Char]
$cshowList :: [ResultComponent] -> ShowS
showList :: [ResultComponent] -> ShowS
Show, (forall x. ResultComponent -> Rep ResultComponent x)
-> (forall x. Rep ResultComponent x -> ResultComponent)
-> Generic ResultComponent
forall x. Rep ResultComponent x -> ResultComponent
forall x. ResultComponent -> Rep ResultComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResultComponent -> Rep ResultComponent x
from :: forall x. ResultComponent -> Rep ResultComponent x
$cto :: forall x. Rep ResultComponent x -> ResultComponent
to :: forall x. Rep ResultComponent x -> ResultComponent
Generic,ResultComponent -> ResultComponent -> Bool
(ResultComponent -> ResultComponent -> Bool)
-> (ResultComponent -> ResultComponent -> Bool)
-> Eq ResultComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResultComponent -> ResultComponent -> Bool
== :: ResultComponent -> ResultComponent -> Bool
$c/= :: ResultComponent -> ResultComponent -> Bool
/= :: ResultComponent -> ResultComponent -> Bool
Eq)

makePrisms ''ResultComponent


listToStrWithComma :: [String] -> String
listToStrWithComma :: [[Char]] -> [Char]
listToStrWithComma = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
","

instance ToJSON TxnComment where 
  toJSON :: TxnComment -> Value
toJSON (PayInt [[Char]]
bns ) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayInt:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
listToStrWithComma [[Char]]
bns [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON (PayYield [Char]
bn ) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayYield:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
bn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (PayPrin [[Char]]
bns ) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayPrin:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
listToStrWithComma [[Char]]
bns [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON (WriteOff [Char]
bn Balance
amt ) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<WriteOff:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
bn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Balance -> [Char]
forall a. Show a => a -> [Char]
show Balance
amt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON (FundWith [Char]
b Balance
bal) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<FundWith:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
b[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Balance -> [Char]
forall a. Show a => a -> [Char]
show Balance
bal[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (PayPrinResidual [[Char]]
bns ) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayPrinResidual:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
listToStrWithComma [[Char]]
bns [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON (PayFee [Char]
fn ) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayFee:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON (SeqPayFee [[Char]]
fns) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<SeqPayFee:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
listToStrWithComma [[Char]]
fns[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (PayFeeYield [Char]
fn) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayFeeYield:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fn[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (Transfer [Char]
an1 [Char]
an2) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Transfer:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
an1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
an2[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (TransferBy [Char]
an1 [Char]
an2 Limit
limit) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<TransferBy:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
an1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
an2[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Limit -> [Char]
forall a. Show a => a -> [Char]
show Limit
limit[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (PoolInflow Maybe [PoolId]
mPids PoolSource
ps) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Pool"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> ([PoolId] -> [Char]) -> Maybe [PoolId] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"|" ([[Char]] -> [Char])
-> ([PoolId] -> [[Char]]) -> [PoolId] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolId -> [Char]
forall a. Show a => a -> [Char]
show (PoolId -> [Char]) -> [PoolId] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) Maybe [PoolId]
mPids [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
":"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PoolSource -> [Char]
forall a. Show a => a -> [Char]
show PoolSource
ps[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (LiquidationProceeds [PoolId]
pids) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Liquidation:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
listToStrWithComma (PoolId -> [Char]
forall a. Show a => a -> [Char]
show (PoolId -> [Char]) -> [PoolId] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PoolId]
pids) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (UsingDS DealStats
ds) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<DS:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DealStats -> [Char]
forall a. Show a => a -> [Char]
show DealStats
ds[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON TxnComment
BankInt =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<BankInterest:>"
  toJSON TxnComment
Empty =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"" 
  toJSON (LiquidationSupport [Char]
source) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Support:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
source[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (LiquidationSupportInt Balance
b1 Balance
b2) =  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<SupportExp:(Int:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Balance -> [Char]
forall a. Show a => a -> [Char]
show Balance
b1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
",Fee:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Balance -> [Char]
forall a. Show a => a -> [Char]
show Balance
b2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")>"
  toJSON TxnComment
LiquidationDraw = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Draw:>"
  toJSON (LiquidationRepay [Char]
s) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Repay:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON TxnComment
SwapAccrue = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Accure:>"
  toJSON (SwapInSettle [Char]
s)= Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<SettleIn:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (SwapOutSettle [Char]
s) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<SettleOut:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (PurchaseAsset [Char]
rPoolName Balance
bal) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PurchaseAsset:"[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
rPoolName [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Balance -> [Char]
forall a. Show a => a -> [Char]
show Balance
bal[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (TxnDirection BookDirection
dr) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<TxnDirection:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++BookDirection -> [Char]
forall a. Show a => a -> [Char]
show BookDirection
dr[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON TxnComment
SupportDraw = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<SupportDraw:>"
  toJSON (IssuanceProceeds [Char]
nb) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<IssuanceProceeds:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
nb[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (Tag [Char]
cmt) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<Tag:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
cmt[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">"
  toJSON (TxnComments [TxnComment]
tcms) = Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (TxnComment -> Value) -> [TxnComment] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map TxnComment -> Value
forall a. ToJSON a => a -> Value
toJSON [TxnComment]
tcms
  toJSON (PayGroupInt [[Char]]
bns) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayGroupInt:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
listToStrWithComma [[Char]]
bns [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON (PayGroupPrin [[Char]]
bns) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<PayGroupPrin:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
listToStrWithComma [[Char]]
bns [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON (BookLedgerBy BookDirection
dr [Char]
lName) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"<BookLedger:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
lName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  toJSON TxnComment
x = [Char] -> Value
forall a. HasCallStack => [Char] -> a
error ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ [Char]
"Not support for toJSON for "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++TxnComment -> [Char]
forall a. Show a => a -> [Char]
show TxnComment
x

instance FromJSON TxnComment where
    parseJSON :: Value -> Parser TxnComment
parseJSON = [Char] -> (Text -> Parser TxnComment) -> Value -> Parser TxnComment
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Empty" Text -> Parser TxnComment
parseTxn

parseTxn :: T.Text -> Parser TxnComment 
parseTxn :: Text -> Parser TxnComment
parseTxn Text
"" = TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TxnComment
Empty 
parseTxn Text
"<BankInt>" = TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TxnComment
BankInt
parseTxn Text
t = case [Char]
tagName of 
  [Char]
"Transfer" -> let 
                  sv :: [Text]
sv = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
                in 
                  TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> TxnComment
Transfer (Text -> [Char]
T.unpack ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
sv)) (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
1))
  [Char]
"Support" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
LiquidationSupport [Char]
contents
  [Char]
"PayInt" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [[Char]] -> TxnComment
PayInt [[Char]
contents]
  [Char]
"PayYield" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
PayYield [Char]
contents
  [Char]
"PayPrin" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [[Char]] -> TxnComment
PayPrin [[Char]
contents]
  [Char]
"WriteOff" -> let 
                  sv :: [Text]
sv = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
                in 
                  TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> Balance -> TxnComment
WriteOff (Text -> [Char]
T.unpack ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
sv)) ([Char] -> Balance
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
1))::Balance)
  [Char]
"PayPrinResidual" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [[Char]] -> TxnComment
PayPrinResidual [[Char]
contents]
  [Char]
"PayFee" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
PayFee [Char]
contents
  [Char]
"SeqPayFee" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [[Char]] -> TxnComment
SeqPayFee [[Char]
contents]
  [Char]
"PayFeeYield" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
PayFeeYield [Char]
contents
  [Char]
"TransferBy" -> let 
                  sv :: [Text]
sv = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
                in 
                  TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Limit -> TxnComment
TransferBy (Text -> [Char]
T.unpack ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
sv)) (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
1)) ([Char] -> Limit
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
2))::Limit)
  [Char]
"Pool" -> let 
              sr :: [Text]
sr = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
":") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
              mPids :: Maybe [PoolId]
mPids = if [Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
sr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Nothing" then 
                        Maybe [PoolId]
forall a. Maybe a
Nothing 
                      else 
                        [PoolId] -> Maybe [PoolId]
forall a. a -> Maybe a
Just ([Char] -> PoolId
forall a. Read a => [Char] -> a
read ([Char] -> PoolId) -> (Text -> [Char]) -> Text -> PoolId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Char]
T.unpack (Text -> PoolId) -> [Text] -> [PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
sr)::(Maybe [PoolId])
            in 
              TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ Maybe [PoolId] -> PoolSource -> TxnComment
PoolInflow Maybe [PoolId]
mPids ([Char] -> PoolSource
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text]
sr[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
1))::PoolSource)
  [Char]
"Liquidation" -> let 
                      sv :: [Text]
sv = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
                      [PoolId]
pids::[PoolId] = [Char] -> PoolId
forall a. Read a => [Char] -> a
read ([Char] -> PoolId) -> (Text -> [Char]) -> Text -> PoolId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Char]
T.unpack (Text -> PoolId) -> [Text] -> [PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
sv
                    in
                      TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [PoolId] -> TxnComment
LiquidationProceeds [PoolId]
pids

  [Char]
"DS" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ DealStats -> TxnComment
UsingDS ([Char] -> DealStats
forall a. Read a => [Char] -> a
read ([Char]
contents)::DealStats)
  [Char]
"LiquidationSupportExp" -> let 
                              sv :: [Text]
sv = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
                            in 
                              TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ Balance -> Balance -> TxnComment
LiquidationSupportInt ([Char] -> Balance
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
sv))::Balance) ([Char] -> Balance
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
1))::Balance)
  [Char]
"SupportDraw" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TxnComment
SupportDraw
  [Char]
"Draw" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TxnComment
LiquidationDraw
  [Char]
"Repay" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
LiquidationRepay [Char]
contents
  [Char]
"Accure" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TxnComment
SwapAccrue
  [Char]
"SettleIn" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
SwapInSettle [Char]
contents
  [Char]
"SettleOut" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
SwapOutSettle [Char]
contents
  [Char]
"PurchaseAsset" -> let 
                      sv :: [Text]
sv = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
                     in 
                      TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> Balance -> TxnComment
PurchaseAsset (ShowS
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
0))::String)  ([Char] -> Balance
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
1))::Balance)

  [Char]
"TxnDirection" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ BookDirection -> TxnComment
TxnDirection ([Char] -> BookDirection
forall a. Read a => [Char] -> a
read [Char]
contents::BookDirection)
  [Char]
"FundWith" -> let 
                  sv :: [Text]
sv = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents
                in 
                  TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> Balance -> TxnComment
FundWith (Text -> [Char]
T.unpack ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
sv)) ([Char] -> Balance
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack ([Text]
sv[Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!!Int
1))::Balance)
--   toJSON (IssuanceProceeds nb) = String $ T.pack $ "<IssuanceProceeds:"++nb++">"
  [Char]
"IssuanceProceeds" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
IssuanceProceeds [Char]
contents                  
  [Char]
"Tag" -> TxnComment -> Parser TxnComment
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxnComment -> Parser TxnComment)
-> TxnComment -> Parser TxnComment
forall a b. (a -> b) -> a -> b
$ [Char] -> TxnComment
Tag [Char]
contents                  
  where 
      pat :: [Char]
pat = [Char]
"<(\\S+):(\\S+)>"::String
      sr :: [[[Char]]]
sr = (Text -> [Char]
T.unpack Text
t [Char] -> [Char] -> [[[Char]]]
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ [Char]
pat)::[[String]]
      tagName :: [Char]
tagName =  [[[Char]]] -> [[Char]]
forall a. HasCallStack => [a] -> a
head [[[Char]]]
sr[[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!!Int
1::String
      contents :: [Char]
contents = [[[Char]]] -> [[Char]]
forall a. HasCallStack => [a] -> a
head [[[Char]]]
sr[[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!!Int
2::String


data DealStatType = RtnBalance 
                  | RtnRate 
                  | RtnBool 
                  | RtnInt
                  deriving (Int -> DealStatType -> ShowS
[DealStatType] -> ShowS
DealStatType -> [Char]
(Int -> DealStatType -> ShowS)
-> (DealStatType -> [Char])
-> ([DealStatType] -> ShowS)
-> Show DealStatType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DealStatType -> ShowS
showsPrec :: Int -> DealStatType -> ShowS
$cshow :: DealStatType -> [Char]
show :: DealStatType -> [Char]
$cshowList :: [DealStatType] -> ShowS
showList :: [DealStatType] -> ShowS
Show,DealStatType -> DealStatType -> Bool
(DealStatType -> DealStatType -> Bool)
-> (DealStatType -> DealStatType -> Bool) -> Eq DealStatType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DealStatType -> DealStatType -> Bool
== :: DealStatType -> DealStatType -> Bool
$c/= :: DealStatType -> DealStatType -> Bool
/= :: DealStatType -> DealStatType -> Bool
Eq,Eq DealStatType
Eq DealStatType =>
(DealStatType -> DealStatType -> Ordering)
-> (DealStatType -> DealStatType -> Bool)
-> (DealStatType -> DealStatType -> Bool)
-> (DealStatType -> DealStatType -> Bool)
-> (DealStatType -> DealStatType -> Bool)
-> (DealStatType -> DealStatType -> DealStatType)
-> (DealStatType -> DealStatType -> DealStatType)
-> Ord DealStatType
DealStatType -> DealStatType -> Bool
DealStatType -> DealStatType -> Ordering
DealStatType -> DealStatType -> DealStatType
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 :: DealStatType -> DealStatType -> Ordering
compare :: DealStatType -> DealStatType -> Ordering
$c< :: DealStatType -> DealStatType -> Bool
< :: DealStatType -> DealStatType -> Bool
$c<= :: DealStatType -> DealStatType -> Bool
<= :: DealStatType -> DealStatType -> Bool
$c> :: DealStatType -> DealStatType -> Bool
> :: DealStatType -> DealStatType -> Bool
$c>= :: DealStatType -> DealStatType -> Bool
>= :: DealStatType -> DealStatType -> Bool
$cmax :: DealStatType -> DealStatType -> DealStatType
max :: DealStatType -> DealStatType -> DealStatType
$cmin :: DealStatType -> DealStatType -> DealStatType
min :: DealStatType -> DealStatType -> DealStatType
Ord,ReadPrec [DealStatType]
ReadPrec DealStatType
Int -> ReadS DealStatType
ReadS [DealStatType]
(Int -> ReadS DealStatType)
-> ReadS [DealStatType]
-> ReadPrec DealStatType
-> ReadPrec [DealStatType]
-> Read DealStatType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DealStatType
readsPrec :: Int -> ReadS DealStatType
$creadList :: ReadS [DealStatType]
readList :: ReadS [DealStatType]
$creadPrec :: ReadPrec DealStatType
readPrec :: ReadPrec DealStatType
$creadListPrec :: ReadPrec [DealStatType]
readListPrec :: ReadPrec [DealStatType]
Read,(forall x. DealStatType -> Rep DealStatType x)
-> (forall x. Rep DealStatType x -> DealStatType)
-> Generic DealStatType
forall x. Rep DealStatType x -> DealStatType
forall x. DealStatType -> Rep DealStatType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DealStatType -> Rep DealStatType x
from :: forall x. DealStatType -> Rep DealStatType x
$cto :: forall x. Rep DealStatType x -> DealStatType
to :: forall x. Rep DealStatType x -> DealStatType
Generic)

getDealStatType :: DealStats -> DealStatType
getDealStatType :: DealStats -> DealStatType
getDealStatType (CumulativePoolDefaultedRateTill Int
_ Maybe [PoolId]
_) = DealStatType
RtnRate
getDealStatType (CumulativePoolDefaultedRate Maybe [PoolId]
_) = DealStatType
RtnRate
getDealStatType (CumulativeNetLossRatio Maybe [PoolId]
_) = DealStatType
RtnRate
getDealStatType DealStats
BondFactor = DealStatType
RtnRate
getDealStatType (BondFactorOf [Char]
_) = DealStatType
RtnRate
getDealStatType (PoolFactor Maybe [PoolId]
_) = DealStatType
RtnRate
getDealStatType (FutureCurrentBondFactor Day
_) = DealStatType
RtnRate
getDealStatType (FutureCurrentPoolFactor Day
_ Maybe [PoolId]
_) = DealStatType
RtnRate
getDealStatType (BondWaRate [[Char]]
_) = DealStatType
RtnRate
getDealStatType (PoolWaRate Maybe PoolId
_) = DealStatType
RtnRate
getDealStatType (BondRate [Char]
_) = DealStatType
RtnRate
getDealStatType DivideRatio {} = DealStatType
RtnRate
getDealStatType AvgRatio {} = DealStatType
RtnRate
getDealStatType (DealStatRate DealStatFields
_) = DealStatType
RtnRate
getDealStatType (Avg [DealStats]
dss) = DealStatType
RtnRate
getDealStatType (Divide DealStats
ds1 DealStats
ds2) = DealStatType
RtnRate
getDealStatType (Multiply [DealStats]
_) = DealStatType
RtnRate
getDealStatType (Factor DealStats
_ Rate
_) = DealStatType
RtnRate
getDealStatType (PoolWaSpread Maybe [PoolId]
_) = DealStatType
RtnRate

getDealStatType (CurrentPoolBorrowerNum Maybe [PoolId]
_) = DealStatType
RtnInt
getDealStatType (MonthsTillMaturity [Char]
_) = DealStatType
RtnInt
getDealStatType DealStats
ProjCollectPeriodNum = DealStatType
RtnInt
getDealStatType (DealStatInt DealStatFields
_) = DealStatType
RtnInt

getDealStatType (IsMostSenior [Char]
_ [[Char]]
_) = DealStatType
RtnBool
getDealStatType IsPaidOff {} = DealStatType
RtnBool
getDealStatType IsOutstanding {} = DealStatType
RtnBool
getDealStatType HasPassedMaturity {} = DealStatType
RtnBool
getDealStatType (TriggersStatus DealCycle
_ [Char]
_)= DealStatType
RtnBool
getDealStatType (IsDealStatus DealStatus
_)= DealStatType
RtnBool
getDealStatType TestRate {} = DealStatType
RtnBool
getDealStatType (TestAny Bool
_ [DealStats]
_) = DealStatType
RtnBool
getDealStatType (TestAll Bool
_ [DealStats]
_) = DealStatType
RtnBool
getDealStatType (DealStatBool DealStatFields
_) = DealStatType
RtnBool

getDealStatType (Max [DealStats]
dss) = DealStats -> DealStatType
getDealStatType ([DealStats] -> DealStats
forall a. HasCallStack => [a] -> a
head [DealStats]
dss)
getDealStatType (Min [DealStats]
dss) = DealStats -> DealStatType
getDealStatType ([DealStats] -> DealStats
forall a. HasCallStack => [a] -> a
head [DealStats]
dss)
getDealStatType DealStats
_ = DealStatType
RtnBalance

dealStatType :: p -> DealStatType
dealStatType p
_ = DealStatType
RtnBalance

data CustomDataType = CustomConstant Rational 
                    | CustomCurve    Ts 
                    | CustomDS       DealStats
                    deriving (Int -> CustomDataType -> ShowS
[CustomDataType] -> ShowS
CustomDataType -> [Char]
(Int -> CustomDataType -> ShowS)
-> (CustomDataType -> [Char])
-> ([CustomDataType] -> ShowS)
-> Show CustomDataType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomDataType -> ShowS
showsPrec :: Int -> CustomDataType -> ShowS
$cshow :: CustomDataType -> [Char]
show :: CustomDataType -> [Char]
$cshowList :: [CustomDataType] -> ShowS
showList :: [CustomDataType] -> ShowS
Show,Eq CustomDataType
Eq CustomDataType =>
(CustomDataType -> CustomDataType -> Ordering)
-> (CustomDataType -> CustomDataType -> Bool)
-> (CustomDataType -> CustomDataType -> Bool)
-> (CustomDataType -> CustomDataType -> Bool)
-> (CustomDataType -> CustomDataType -> Bool)
-> (CustomDataType -> CustomDataType -> CustomDataType)
-> (CustomDataType -> CustomDataType -> CustomDataType)
-> Ord CustomDataType
CustomDataType -> CustomDataType -> Bool
CustomDataType -> CustomDataType -> Ordering
CustomDataType -> CustomDataType -> CustomDataType
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 :: CustomDataType -> CustomDataType -> Ordering
compare :: CustomDataType -> CustomDataType -> Ordering
$c< :: CustomDataType -> CustomDataType -> Bool
< :: CustomDataType -> CustomDataType -> Bool
$c<= :: CustomDataType -> CustomDataType -> Bool
<= :: CustomDataType -> CustomDataType -> Bool
$c> :: CustomDataType -> CustomDataType -> Bool
> :: CustomDataType -> CustomDataType -> Bool
$c>= :: CustomDataType -> CustomDataType -> Bool
>= :: CustomDataType -> CustomDataType -> Bool
$cmax :: CustomDataType -> CustomDataType -> CustomDataType
max :: CustomDataType -> CustomDataType -> CustomDataType
$cmin :: CustomDataType -> CustomDataType -> CustomDataType
min :: CustomDataType -> CustomDataType -> CustomDataType
Ord,CustomDataType -> CustomDataType -> Bool
(CustomDataType -> CustomDataType -> Bool)
-> (CustomDataType -> CustomDataType -> Bool) -> Eq CustomDataType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomDataType -> CustomDataType -> Bool
== :: CustomDataType -> CustomDataType -> Bool
$c/= :: CustomDataType -> CustomDataType -> Bool
/= :: CustomDataType -> CustomDataType -> Bool
Eq,ReadPrec [CustomDataType]
ReadPrec CustomDataType
Int -> ReadS CustomDataType
ReadS [CustomDataType]
(Int -> ReadS CustomDataType)
-> ReadS [CustomDataType]
-> ReadPrec CustomDataType
-> ReadPrec [CustomDataType]
-> Read CustomDataType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CustomDataType
readsPrec :: Int -> ReadS CustomDataType
$creadList :: ReadS [CustomDataType]
readList :: ReadS [CustomDataType]
$creadPrec :: ReadPrec CustomDataType
readPrec :: ReadPrec CustomDataType
$creadListPrec :: ReadPrec [CustomDataType]
readListPrec :: ReadPrec [CustomDataType]
Read,(forall x. CustomDataType -> Rep CustomDataType x)
-> (forall x. Rep CustomDataType x -> CustomDataType)
-> Generic CustomDataType
forall x. Rep CustomDataType x -> CustomDataType
forall x. CustomDataType -> Rep CustomDataType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomDataType -> Rep CustomDataType x
from :: forall x. CustomDataType -> Rep CustomDataType x
$cto :: forall x. Rep CustomDataType x -> CustomDataType
to :: forall x. Rep CustomDataType x -> CustomDataType
Generic)

opts :: JSONKeyOptions
opts :: JSONKeyOptions
opts = JSONKeyOptions
defaultJSONKeyOptions -- { keyModifier = toLower }


$(deriveJSON defaultOptions ''BondPricingMethod)
$(deriveJSON defaultOptions ''DealStatus)
$(deriveJSON defaultOptions ''CutoffType)
$(deriveJSON defaultOptions ''DealStatFields)
$(concat <$> traverse (deriveJSON defaultOptions) [''BookDirection, ''DealStats, ''PricingMethod, ''DealCycle, ''DateType, ''Period, 
  ''DatePattern, ''Table, ''BalanceSheetReport, ''BookItem, ''CashflowReport, ''Txn] )

instance ToJSONKey DateType where
  toJSONKey :: ToJSONKeyFunction DateType
toJSONKey = JSONKeyOptions -> ToJSONKeyFunction DateType
forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
opts
instance FromJSONKey DateType where
  fromJSONKey :: FromJSONKeyFunction DateType
fromJSONKey = (Text -> Parser DateType) -> FromJSONKeyFunction DateType
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser DateType) -> FromJSONKeyFunction DateType)
-> (Text -> Parser DateType) -> FromJSONKeyFunction DateType
forall a b. (a -> b) -> a -> b
$ \Text
t -> 
    case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
" " Text
t of
      [Text
"CustomExeDates", Text
rest] -> DateType -> Parser DateType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DateType -> Parser DateType) -> DateType -> Parser DateType
forall a b. (a -> b) -> a -> b
$ [Char] -> DateType
CustomExeDates (Text -> [Char]
T.unpack Text
rest)
      [Text]
_ -> case [Char] -> Maybe DateType
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
t) of
        Just DateType
k -> DateType -> Parser DateType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DateType
k
        Maybe DateType
Nothing -> [Char] -> Parser DateType
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid key (DateType): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">>"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (Text -> [Char]
T.unpack Text
t))



$(deriveJSON defaultOptions ''RangeType)
$(deriveJSON defaultOptions ''PerCurve)
$(deriveJSON defaultOptions ''Pre)
$(deriveJSON defaultOptions ''CustomDataType)
$(deriveJSON defaultOptions ''ActionWhen)

instance ToJSONKey ActionWhen where
  toJSONKey :: ToJSONKeyFunction ActionWhen
toJSONKey = (ActionWhen -> Text) -> ToJSONKeyFunction ActionWhen
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ([Char] -> Text
T.pack ([Char] -> Text) -> (ActionWhen -> [Char]) -> ActionWhen -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionWhen -> [Char]
forall a. Show a => a -> [Char]
show)

instance FromJSONKey ActionWhen where
  fromJSONKey :: FromJSONKeyFunction ActionWhen
fromJSONKey = (Text -> Parser ActionWhen) -> FromJSONKeyFunction ActionWhen
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser ActionWhen) -> FromJSONKeyFunction ActionWhen)
-> (Text -> Parser ActionWhen) -> FromJSONKeyFunction ActionWhen
forall a b. (a -> b) -> a -> b
$ \Text
t -> 
    case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
" " Text
t of
      [Text
"CustomWaterfall", Text
rest] -> ActionWhen -> Parser ActionWhen
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionWhen -> Parser ActionWhen)
-> ActionWhen -> Parser ActionWhen
forall a b. (a -> b) -> a -> b
$ [Char] -> ActionWhen
CustomWaterfall (Text -> [Char]
T.unpack Text
rest)
      [Text]
_ -> case [Char] -> Maybe ActionWhen
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
t) of
        Just ActionWhen
k -> ActionWhen -> Parser ActionWhen
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionWhen
k
        Maybe ActionWhen
Nothing -> [Char] -> Parser ActionWhen
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid key (Action When): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">>"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (Text -> [Char]
T.unpack Text
t))


$(deriveJSON defaultOptions ''ResultComponent)
$(deriveJSON defaultOptions ''PriceResult)
$(deriveJSON defaultOptions ''CutoffFields)
$(deriveJSON defaultOptions ''HowToPay)



instance ToJSONKey DealCycle where
  toJSONKey :: ToJSONKeyFunction DealCycle
toJSONKey = (DealCycle -> Text) -> ToJSONKeyFunction DealCycle
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ([Char] -> Text
T.pack ([Char] -> Text) -> (DealCycle -> [Char]) -> DealCycle -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DealCycle -> [Char]
forall a. Show a => a -> [Char]
show)

instance FromJSONKey DealCycle where
  fromJSONKey :: FromJSONKeyFunction DealCycle
fromJSONKey = (Text -> Parser DealCycle) -> FromJSONKeyFunction DealCycle
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser DealCycle) -> FromJSONKeyFunction DealCycle)
-> (Text -> Parser DealCycle) -> FromJSONKeyFunction DealCycle
forall a b. (a -> b) -> a -> b
$ \Text
t -> case [Char] -> Maybe DealCycle
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
t) of
    Just DealCycle
k -> DealCycle -> Parser DealCycle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DealCycle
k
    Maybe DealCycle
Nothing -> [Char] -> Parser DealCycle
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid key: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t)


instance ToJSONKey CutoffFields where
  toJSONKey :: ToJSONKeyFunction CutoffFields
toJSONKey = (CutoffFields -> Text) -> ToJSONKeyFunction CutoffFields
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ([Char] -> Text
Text.pack ([Char] -> Text)
-> (CutoffFields -> [Char]) -> CutoffFields -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CutoffFields -> [Char]
forall a. Show a => a -> [Char]
show)

instance FromJSONKey CutoffFields where
  fromJSONKey :: FromJSONKeyFunction CutoffFields
fromJSONKey = (Text -> Parser CutoffFields) -> FromJSONKeyFunction CutoffFields
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser CutoffFields) -> FromJSONKeyFunction CutoffFields)
-> (Text -> Parser CutoffFields)
-> FromJSONKeyFunction CutoffFields
forall a b. (a -> b) -> a -> b
$ \Text
t -> case [Char] -> Maybe CutoffFields
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
Text.unpack Text
t) of
    Just CutoffFields
k -> CutoffFields -> Parser CutoffFields
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CutoffFields
k
    Maybe CutoffFields
Nothing -> [Char] -> Parser CutoffFields
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid key: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t)


newtype MyRatio = MyRatio (Ratio Integer)

instance ToJSON MyRatio where
  toJSON :: MyRatio -> Value
toJSON (MyRatio Rate
r) = case Maybe Int
-> Rate -> Either (Scientific, Rate) (Scientific, Maybe Int)
fromRationalRepetend Maybe Int
forall a. Maybe a
Nothing Rate
r of
      Left (Scientific
sci, Rate
_)         -> [Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> [Char]
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Scientific
sci
      Right (Scientific
sci, Maybe Int
rep) -> [Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> [Char]
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Scientific
sci

instance Show MyRatio where
  show :: MyRatio -> [Char]
show (MyRatio Rate
r) = case Maybe Int
-> Rate -> Either (Scientific, Rate) (Scientific, Maybe Int)
fromRationalRepetend Maybe Int
forall a. Maybe a
Nothing Rate
r of
      Left (Scientific
sci, Rate
_)         -> ShowS
forall a. Show a => a -> [Char]
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> [Char]
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Scientific
sci
      Right (Scientific
sci, Maybe Int
rep) -> ShowS
forall a. Show a => a -> [Char]
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> [Char]
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Scientific
sci

$(deriveJSON defaultOptions ''Index)
$(deriveJSON defaultOptions ''DayCount)
$(deriveJSON defaultOptions ''Threshold)
instance ToJSONKey Threshold where
  toJSONKey :: ToJSONKeyFunction Threshold
toJSONKey = JSONKeyOptions -> ToJSONKeyFunction Threshold
forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
opts
instance FromJSONKey Threshold where
  fromJSONKey :: FromJSONKeyFunction Threshold
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction Threshold
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
opts


$(deriveJSON defaultOptions ''RateAssumption)
$(deriveJSON defaultOptions ''Direction)

makePrisms ''Txn
$(concat <$> traverse (deriveJSON defaultOptions) [''Limit] )