Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

0.23.5 #131

Merged
merged 16 commits into from
Nov 29, 2023
1 change: 1 addition & 0 deletions app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -225,6 +225,7 @@ instance ToSchema AP.ExtraStress
instance ToSchema AP.AssetDelinquencyAssumption
instance ToSchema AP.LeaseAssetGapAssump
instance ToSchema AP.LeaseAssetRentAssump
instance ToSchema (Table Balance Balance)

instance ToSchema (Ratio Integer) where
declareNamedSchema _ = NamedSchema Nothing <$> declareSchema (Proxy :: Proxy Double)
Expand Down
15 changes: 8 additions & 7 deletions src/AssetClass/Lease.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import GHC.Generics
import Data.Maybe

import AssetClass.AssetBase

Expand Down Expand Up @@ -103,14 +104,14 @@ nextLeaseTill l (rsc,tc,mg) lastDate ed accum
-- _ -> extractAssump aps (a,b,c,d,e)

getGapDaysByBalance :: Lease -> ([(Amount,Int)],Int) -> Int
getGapDaysByBalance l tbl@(rows,defaultVal) =
let
tbl = ThresholdTable rows
pmt = case l of
(RegularLease (LeaseInfo _ _ _ dr) _ _ _) -> dr
(StepUpLease (LeaseInfo _ _ _ dr) _ _ _ _) -> dr
getGapDaysByBalance l tbl@(rows,defaultVal)
= let
tbl = ThresholdTable rows
pmt = case l of
(RegularLease (LeaseInfo _ _ _ dr) _ _ _) -> dr
(StepUpLease (LeaseInfo _ _ _ dr) _ _ _ _) -> dr
in
lookupTable tbl DownwardInclude pmt defaultVal
fromMaybe defaultVal $ lookupTable tbl Down (>= pmt)

projectCfDates :: DatePattern -> Date -> Int -> [Date]
projectCfDates dp sd ot
Expand Down
6 changes: 3 additions & 3 deletions src/Deal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -123,7 +123,7 @@ evalFloaterRate d ras (IR.Floater _ idx spd _r _ mFloor mCap mRounding)
case ra of
Nothing -> error "Failed to find index rate in assumption"
Just (RateFlat _ v) -> capping mCap $ flooring mFloor $ v + spd
Just (RateCurve _ curve) -> capping mCap $ flooring mFloor $ fromRational $ (getValByDate curve Inc d) + (toRational spd)
Just (RateCurve _ curve) -> capping mCap $ flooring mFloor $ fromRational $ getValByDate curve Inc d + toRational spd

applyFloatRate :: L.InterestInfo -> Date -> [RateAssumption] -> IRate
applyFloatRate (L.Floater _ idx spd p dc mf mc) d ras
Expand Down Expand Up @@ -601,7 +601,7 @@ patchIssuanceBalance (PreClosing _ ) bal p@P.Pool{issuanceStat = Just statM } =
patchIssuanceBalance _ bal p = p

getInits :: P.Asset a => TestDeal a -> Maybe AP.ApplyAssumptionType -> Maybe AP.NonPerfAssumption -> (TestDeal a,[ActionOnDate], CF.CashFlowFrame)
getInits t@TestDeal{fees= feeMap,pool=thePool,status=status,bonds=bndMap} mAssumps mNonPerfAssump
getInits t@TestDeal{fees=feeMap,pool=thePool,status=status,bonds=bndMap} mAssumps mNonPerfAssump
= (newT, allActionDates, pCollectionCfAfterCutoff) -- `debug` ("init done actions->"++ show pCollectionCfAfterCutoff)
where
(startDate,closingDate,firstPayDate,pActionDates,bActionDates,endDate) = populateDealDates (dates t)
Expand All @@ -611,7 +611,7 @@ getInits t@TestDeal{fees= feeMap,pool=thePool,status=status,bonds=bndMap} mAssum
iAccIntDates = [ EarnAccInt _d accName | (accName,accIntDates) <- intEarnDates
, _d <- accIntDates ] -- `debug` ("PoolactionDates"++show pActionDates)
--fee accrue dates
_feeAccrueDates = F.buildFeeAccrueAction (Map.elems (fees t)) endDate []
_feeAccrueDates = F.buildFeeAccrueAction (Map.elems feeMap) endDate []
feeAccrueDates = [ AccrueFee _d _feeName | (_feeName,feeAccureDates) <- _feeAccrueDates
, _d <- feeAccureDates ]
--liquidation facility
Expand Down
22 changes: 18 additions & 4 deletions src/Deal/DealAction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -184,7 +184,6 @@ calcDueFee t calcDay f@(F.Fee fn (F.RecurFee p amt) fs fd mLastAccDate fa _ _)
Just lastAccDate -> genSerialDatesTill2 NO_IE lastAccDate p calcDay
periodGaps = length accDates


calcDueFee t calcDay f@(F.Fee fn (F.NumFee p s amt) fs fd Nothing fa lpd _)
| calcDay >= fs = calcDueFee t calcDay f {F.feeDueDate = Just fs }
| otherwise = f
Expand All @@ -206,6 +205,21 @@ calcDueFee t calcDay f@(F.Fee fn (F.TargetBalanceFee dsDue dsPaid) fs fd _ fa lp
dsPaidD = patchDateToStats calcDay dsPaid
dueAmt = max 0 $ queryDeal t dsDueD - queryDeal t dsPaidD

calcDueFee t@TestDeal{ pool = pool } calcDay f@(F.Fee fn (F.ByCollectPeriod amt) fs fd fdday fa lpd _)
= f {F.feeDue = dueAmt + fd, F.feeDueDate = Just calcDay}
where
txnsDates = getDate <$> maybe [] CF.getTsCashFlowFrame (view P.poolFutureCf pool)
pastPeriods = case fdday of
Nothing -> subDates II fs calcDay txnsDates
Just lastFeeDueDay -> subDates EI lastFeeDueDay calcDay txnsDates
dueAmt = fromRational $ mulBInt amt (length pastPeriods)

calcDueFee t calcDay f@(F.Fee fn (F.AmtByTbl _ ds tbl) fs fd fdday fa lpd _)
= f {F.feeDue = dueAmt + fd, F.feeDueDate = Just calcDay}
where
lookupVal = queryDeal t (patchDateToStats calcDay ds)
dueAmt = fromMaybe 0.0 $ lookupTable tbl Up (lookupVal >=)

disableLiqProvider :: P.Asset a => TestDeal a -> Date -> CE.LiqFacility -> CE.LiqFacility
disableLiqProvider _ d liq@CE.LiqFacility{CE.liqEnds = Just endDate }
| d > endDate = liq{CE.liqCredit = Just 0}
Expand All @@ -218,9 +232,9 @@ updateLiqProvider t d liq@CE.LiqFacility{CE.liqType = liqType, CE.liqCredit = cu
= disableLiqProvider t d $ liq { CE.liqCredit = newCredit }
where
newCredit = case liqType of
CE.ReplenishSupport _ b -> max b <$> curCredit
CE.ByPct ds _r -> min (mulBR (queryDeal t ds) _r) <$> curCredit
_ -> curCredit
CE.ReplenishSupport _ b -> max b <$> curCredit
CE.ByPct ds _r -> min (mulBR (queryDeal t ds) _r) <$> curCredit
_ -> curCredit

updateLiqProvider t d liq = disableLiqProvider t d liq

Expand Down
15 changes: 10 additions & 5 deletions src/Deal/DealQuery.hs
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,7 @@ queryDealRate t s =
cumuPoolDefBal / originPoolBal -- `debug` ("cumulative p def rate"++show cumuPoolDefBal++">>"++show originPoolBal)

CumulativeNetLossRatio ->
toRational $ (queryDeal t CumulativeNetLoss)/(queryDeal t OriginalPoolBalance)
toRational $ (queryDeal t CumulativeNetLoss) / (queryDeal t OriginalPoolBalance)

CumulativePoolDefaultedRateTill idx ->
let
Expand Down Expand Up @@ -139,7 +139,7 @@ queryDealRate t s =
CapWith s cap -> toRational $ min (queryDealRate t s) (queryDealRate t cap)

queryDealInt :: P.Asset a => TestDeal a -> DealStats -> Date -> Int
queryDealInt t s d =
queryDealInt t@TestDeal{ pool = p ,bonds = bndMap } s d =
case s of
FutureCurrentPoolBorrowerNum d ->
case P.futureCf (pool t) of
Expand All @@ -155,7 +155,10 @@ queryDealInt t s d =
Nothing -> error "Should not happend"
Just md -> fromInteger $ T.cdMonths $ T.diffGregorianDurationClip md d
where
(L.Bond _ _ (L.OriginalInfo _ _ _ mm) _ _ _ _ _ _ _ _ _ _) = (bonds t) Map.! bn
(L.Bond _ _ (L.OriginalInfo _ _ _ mm) _ _ _ _ _ _ _ _ _ _) = bndMap Map.! bn

ProjCollectPeriodNum -> length $ maybe [] CF.getTsCashFlowFrame $ view P.poolFutureCf p -- `debug` ("Hit query")

FloorAndCap floor cap s -> max (queryDealInt t floor d) $ min (queryDealInt t cap d ) (queryDealInt t s d)
FloorWith s floor -> max (queryDealInt t s d) (queryDealInt t floor d)
FloorWithZero s -> max (queryDealInt t s d) 0
Expand Down Expand Up @@ -446,12 +449,14 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM

Sum _s -> sum $ map (queryDeal t) _s

Substract (ds:dss) ->
Subtract (ds:dss) ->
let
a = queryDeal t ds
bs = queryDeal t (Sum dss)
in
a - bs
a - bs

Substract s -> queryDeal t (Subtract s)

Avg dss -> divideBI (sum ( queryDeal t <$> dss )) (length dss)

Expand Down
Loading
Loading