From 142c09f03e8f9647aaf36464b8f5af8b9fc5722f Mon Sep 17 00:00:00 2001 From: Shawn Zhang Date: Thu, 30 Nov 2023 02:23:57 +0800 Subject: [PATCH] 0.23.5 (#131) * expose bond pay shortcut * expose bond pay int shortcut * add condtional support * add Do Nothing on trigger effects * expose PayFeeBySeq * fix irr * bump version to-> < 0.23.4 > * add support draw * update wkflow * add fee by collection period * expose query on collection period * expose lookup table fee & refactor table lookup * expose projection periods * fix typo * expose fee by table --------- Co-authored-by: yellowbean --- app/Main.hs | 1 + src/AssetClass/Lease.hs | 15 ++-- src/Deal.hs | 6 +- src/Deal/DealAction.hs | 22 +++++- src/Deal/DealQuery.hs | 15 ++-- src/Deal/DealValidation.hs | 157 +++++++++++++++++++------------------ src/Expense.hs | 20 +++-- src/Types.hs | 41 +++++----- swagger.json | 84 +++++++++++++++++++- test/MainTest.hs | 1 + test/UT/UtilTest.hs | 28 ++++++- 11 files changed, 267 insertions(+), 123 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index dd34faab..7317a0fd 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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) diff --git a/src/AssetClass/Lease.hs b/src/AssetClass/Lease.hs index 8c2840a7..8cb2251a 100644 --- a/src/AssetClass/Lease.hs +++ b/src/AssetClass/Lease.hs @@ -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 @@ -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 diff --git a/src/Deal.hs b/src/Deal.hs index 3aa9616b..22c904c9 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -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 @@ -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) @@ -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 diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 9cd062dc..c18b4559 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -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 @@ -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} @@ -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 diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index 07ef0295..b7e096cf 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -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 @@ -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 @@ -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 @@ -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) diff --git a/src/Deal/DealValidation.hs b/src/Deal/DealValidation.hs index 28bbe0c9..1ac174cc 100644 --- a/src/Deal/DealValidation.hs +++ b/src/Deal/DealValidation.hs @@ -34,124 +34,129 @@ isPreClosing :: TestDeal a -> Bool isPreClosing t@TestDeal{ status = PreClosing _ } = True isPreClosing _ = False -validateAction :: [W.Action] -> [ResultComponent] -> Set.Set String -> Set.Set String -> Set.Set String-> Set.Set String-> Set.Set String -> Set.Set String -> [ResultComponent] -validateAction [] rs _ _ _ _ _ _ = rs -validateAction ((W.Transfer _ acc1 acc2 _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction :: [W.Action] -> [ResultComponent] -> Set.Set String -> Set.Set String -> Set.Set String-> Set.Set String-> Set.Set String -> Set.Set String -> Set.Set String -> [ResultComponent] +validateAction [] rs _ _ _ _ _ _ _ = rs +validateAction ((W.Transfer _ acc1 acc2 _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember acc1 accKeys || Set.notMember acc2 accKeys - = validateAction as (rs ++ [ErrorMsg (acc1 ++","++acc2++" not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (acc1 ++","++acc2++" not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.CalcFee fees):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.CalcFee fees):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList fees) feeKeys) - = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.PayFee _ accName fees _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.PayFee _ accName fees _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList fees) feeKeys) || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys++" Or "++ show accName ++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys++" Or "++ show accName ++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.CalcAndPayFee _ accName fees _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.CalcAndPayFee _ accName fees _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList fees) feeKeys) || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys++" Or "++ accName ++" not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show fees ++ " not in "++ show feeKeys++" Or "++ accName ++" not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.PayFeeResidual _ accName feeName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.PayFeeResidual _ accName feeName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember feeName feeKeys || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (feeName ++ " not in "++ show feeKeys++" Or "++accName++ " not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (feeName ++ " not in "++ show feeKeys++" Or "++accName++ " not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.CalcBondInt bnds):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.CalcBondInt bnds):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) - = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.PayInt _ accName bnds _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.PayInt _ accName bnds _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.AccrueAndPayInt _ accName bnds _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.AccrueAndPayInt _ accName bnds _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show bnds ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.PayIntResidual _ accName bndName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.PayIntResidual _ accName bndName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember bndName bndKeys || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (bndName ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (bndName ++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.PayPrin _ accName bnds _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.PayPrin _ accName bnds _):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.PayPrinResidual accName bnds):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.PayPrinResidual accName bnds):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | not (Set.isSubsetOf (Set.fromList bnds) bndKeys) || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (show bnds++ " not in "++ show bndKeys++" Or "++accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.BuyAsset _ _ accName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.BuyAsset _ _ accName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.LiquidatePool _ accName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.LiquidatePool _ accName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | Set.notMember accName accKeys = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.LiqSupport _ liqName _ accName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.LiqSupport _ liqName _ accName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember accName accKeys || Set.notMember liqName liqProviderKeys - = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.LiqRepay _ _ accName liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.LiqRepay _ _ accName liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember accName accKeys || Set.notMember liqName liqProviderKeys - = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.LiqYield _ accName liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.LiqYield _ accName liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember accName accKeys || Set.notMember liqName liqProviderKeys - = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (accName++" not in "++show accKeys++" Or "++liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.LiqAccrue liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.LiqAccrue liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember liqName liqProviderKeys - = validateAction as (rs ++ [ErrorMsg (liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.LiqAccrue liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.LiqAccrue liqName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember liqName liqProviderKeys - = validateAction as (rs ++ [ErrorMsg (liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (liqName ++" not in "++ show liqProviderKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.SwapAccrue rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.SwapAccrue rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember rsName rateSwapKeys - = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.SwapReceive accName rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.SwapReceive accName rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember rsName rateSwapKeys || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.SwapPay accName rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.SwapPay accName rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember rsName rateSwapKeys || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.SwapSettle accName rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.SwapSettle accName rsName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys | Set.notMember rsName rateSwapKeys || Set.notMember accName accKeys - = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys + = validateAction as (rs ++ [ErrorMsg (rsName ++" not in "++ show rateSwapKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.ActionWithPre p subActionList):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - = validateAction (subActionList++as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.CollectRateCap accName rcName):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | Set.notMember rcName rcKeys || Set.notMember accName accKeys + = validateAction as (rs ++ [ErrorMsg (rcName ++" not in "++ show rcKeys ++ " Or "++ accName ++ " not in "++ show accKeys)]) accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + | otherwise = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction ((W.ActionWithPre2 p subActionList1 subActionList2):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - = validateAction (subActionList1++subActionList2++as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.ActionWithPre p subActionList):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + = validateAction (subActionList++as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys -validateAction (action:as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys - = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys +validateAction ((W.ActionWithPre2 p subActionList1 subActionList2):as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + = validateAction (subActionList1++subActionList2++as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + +validateAction (action:as) rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys + = validateAction as rs accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rcKeys ledgerKeys extractRequiredRates :: IR.UseRate a => TestDeal a -> Set.Set Index extractRequiredRates t@TestDeal{accounts = accM @@ -217,6 +222,7 @@ validatePreRun t@TestDeal{waterfall=waterfallM ,collects = aggRule ,liqProvider = liqProviderM ,rateSwap = rsM + ,rateCap = rcM ,triggers = triggerM ,ledgers = ledgerM ,pool = pool @@ -229,6 +235,7 @@ validatePreRun t@TestDeal{waterfall=waterfallM waterfallKeys = Map.keysSet waterfallM liqProviderKeys = maybe Set.empty Map.keysSet liqProviderM rateSwapKeys = maybe Set.empty Map.keysSet rsM + rateCapKeys = maybe Set.empty Map.keysSet rcM ledgerKeys = maybe Set.empty Map.keysSet ledgerM triggerKeys = maybe Set.empty Map.keysSet triggerM -- date check @@ -244,7 +251,7 @@ validatePreRun t@TestDeal{waterfall=waterfallM -- TODO : collectCash shouldn't overlap with others -- waterfall key not exists test error - errors = concat $ (\x -> validateAction x [] accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys ledgerKeys) <$> Map.elems waterfallM + errors = concat $ (\x -> validateAction x [] accKeys bndKeys feeKeys liqProviderKeys rateSwapKeys rateCapKeys ledgerKeys) <$> Map.elems waterfallM -- waterfall action coverage check diff --git a/src/Expense.hs b/src/Expense.hs index f8d64e90..ad76bd9c 100644 --- a/src/Expense.hs +++ b/src/Expense.hs @@ -33,13 +33,15 @@ debug = flip trace type FormulaRate = DealStats -data FeeType = AnnualRateFee DealStats FormulaRate -- ^ annulized fee with a referece - | PctFee DealStats FormulaRate -- ^ fee base on percentage - | FixFee Balance -- ^ one-off fee - | RecurFee DatePattern Balance -- ^ fee occur every date pattern - | NumFee DatePattern DealStats Amount -- ^ fee based on an integer number - | TargetBalanceFee DealStats DealStats -- ^ fee occur if (ds1 > ds2) - | FeeFlow Ts -- ^ a time series based fee +data FeeType = AnnualRateFee DealStats FormulaRate -- ^ annulized fee with a referece + | PctFee DealStats FormulaRate -- ^ fee base on percentage + | FixFee Balance -- ^ one-off fee + | RecurFee DatePattern Balance -- ^ fee occur every date pattern + | NumFee DatePattern DealStats Amount -- ^ fee based on an integer number + | AmtByTbl DatePattern DealStats (Table Balance Balance) -- ^ lookup query value in a table + | TargetBalanceFee DealStats DealStats -- ^ fee occur if (ds1 > ds2) + | FeeFlow Ts -- ^ a time series based fee + | ByCollectPeriod Amount -- ^ fix amount per collection period deriving (Show,Eq, Generic) data Fee = Fee { @@ -89,6 +91,10 @@ buildFeeAccrueAction (fee:fees) ed r = -> buildFeeAccrueAction fees ed [(fn, [fs])]++r (Fee fn (FeeFlow _ts) _ _ _ _ _ _) -> buildFeeAccrueAction fees ed [(fn, getTsDates _ts)]++r + (Fee fn (NumFee dp _ _) fs _ _ _ _ _) + -> buildFeeAccrueAction fees ed [(fn, projDatesByPattern dp fs ed)]++r + (Fee fn (AmtByTbl dp _ _) fs _ _ _ _ _) + -> buildFeeAccrueAction fees ed [(fn, projDatesByPattern dp fs ed)]++r _ -> buildFeeAccrueAction fees ed r diff --git a/src/Types.hs b/src/Types.hs index 25d844d8..35b490e5 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -17,7 +17,7 @@ module Types ,ResultComponent(..),SplitType(..),BookItem(..),BookItems,BalanceSheetReport(..),CashflowReport(..) ,Floater,CeName,RateAssumption(..) ,PrepaymentRate,DefaultRate,RecoveryRate,RemainTerms,Recovery,Prepayment - ,Table(..),lookupTable,LookupType(..),epocDate,BorrowerNum + ,Table(..),lookupTable,TableDirection(..),epocDate,BorrowerNum ,PricingMethod(..),sortActionOnDate,PriceResult(..),IRR,Limit(..) ,RoundingBy(..),DateDirection(..) ,TxnComment(..),Direction(..),DealStatType(..),getDealStatType @@ -411,6 +411,7 @@ data DealStats = CurrentBondBalance | OriginalBondBalance | OriginalPoolBalance | CurrentPoolBorrowerNum + | ProjCollectPeriodNum | BondFactor | PoolFactor | BondWaRate [BondName] @@ -476,6 +477,7 @@ data DealStats = CurrentBondBalance | Min [DealStats] | Sum [DealStats] | Substract [DealStats] + | Subtract [DealStats] | Avg [DealStats] | Divide DealStats DealStats | Constant Rational @@ -508,6 +510,7 @@ getDealStatType (BondRate _) = RtnRate getDealStatType CurrentPoolBorrowerNum = RtnInt getDealStatType (MonthsTillMaturity _) = RtnInt +getDealStatType ProjCollectPeriodNum = RtnInt getDealStatType (IsMostSenior _ _) = RtnBool getDealStatType (TriggersStatus _ _)= RtnBool @@ -580,6 +583,10 @@ data RangeType = II -- ^ include both start and end date | EE -- ^ exclude either start date and end date | NO_IE -- ^ no handling on start date and end date +data TableDirection = Up + | Down + deriving (Show,Read,Generic,Eq) + data CutoffType = Inc | Exc deriving (Show,Read,Generic,Eq) @@ -610,7 +617,6 @@ data CashflowReport = CashflowReport { ,endDate :: Date } deriving (Show,Read,Generic) - data ResultComponent = CallAt Date -- ^ the date when deal called | DealStatusChangeTo Date DealStatus DealStatus -- ^ record when status changed | BondOutstanding String Balance Balance -- ^ when deal ends,calculate oustanding principal balance @@ -706,29 +712,25 @@ class Liable lb where -- getTotalDue :: [lb] -> Balance -- getTotalDue lbs = sum $ getDue <$> lbs -data LookupType = Upward - | Downward - | UpwardInclude - | DownwardInclude - data Table a b = ThresholdTable [(a,b)] + deriving (Show,Eq,Ord,Read,Generic) -lookupTable :: Ord a => Table a b -> LookupType -> a -> b -> b -lookupTable (ThresholdTable rows) lkupType lkupVal notFound - = case findIndex (lkUpFunc lkupVal) rs of - Nothing -> notFound - Just i -> snd $ rows!!i +lookupTable :: Ord a => Table a b -> TableDirection -> (a -> Bool) -> Maybe b +lookupTable (ThresholdTable rows) direction lkUpFunc + = case findIndex lkUpFunc rs of + Nothing -> Nothing + Just i -> Just $ vs!!i where - rs = map fst rows - lkUpFunc = case lkupType of - Upward -> (>) - UpwardInclude -> (>=) - Downward -> (<) - DownwardInclude -> (<=) + rs = case direction of + Up -> reverse $ map fst rows + Down -> map fst rows + vs = case direction of + Up -> reverse $ map snd rows + Down -> map snd rows data RateAssumption = RateCurve Index Ts -- ^ a rate curve ,which value of rates depends on time | RateFlat Index IRate -- ^ a rate constant - deriving (Show,Generic) + deriving (Show, Generic) 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 @@ -803,3 +805,4 @@ $(deriveJSON defaultOptions ''Limit) $(deriveJSON defaultOptions ''RoundingBy) $(deriveJSON defaultOptions ''CutoffFields) $(deriveJSON defaultOptions ''RateAssumption) +$(deriveJSON defaultOptions ''Table) diff --git a/swagger.json b/swagger.json index 24f7e402..4697f7fc 100644 --- a/swagger.json +++ b/swagger.json @@ -5669,6 +5669,20 @@ "tag" ] }, + { + "type": "object", + "properties": { + "tag": { + "type": "string", + "enum": [ + "ProjCollectPeriodNum" + ] + } + }, + "required": [ + "tag" + ] + }, { "type": "object", "properties": { @@ -8397,6 +8411,37 @@ "contents" ] }, + { + "type": "object", + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/DatePattern" + }, + { + "$ref": "#/components/schemas/DealStats" + }, + { + "$ref": "#/components/schemas/Table_(Fixed_*_E2)_(Fixed_*_E2)" + } + ], + "maxItems": 3, + "type": "array", + "minItems": 3 + }, + "tag": { + "type": "string", + "enum": [ + "AmtByTbl" + ] + } + }, + "required": [ + "tag", + "contents" + ] + }, { "type": "object", "properties": { @@ -8442,6 +8487,25 @@ "tag", "contents" ] + }, + { + "type": "object", + "properties": { + "contents": { + "multipleOf": 1.0e-2, + "type": "number" + }, + "tag": { + "type": "string", + "enum": [ + "ByCollectPeriod" + ] + } + }, + "required": [ + "tag", + "contents" + ] } ], "type": "object" @@ -9820,6 +9884,24 @@ }, "type": "array" }, + "Table_(Fixed_*_E2)_(Fixed_*_E2)": { + "items": { + "items": [ + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 2, + "type": "array", + "minItems": 2 + }, + "type": "array" + }, "Fee": { "type": "object", "properties": { @@ -13011,7 +13093,7 @@ } }, "info": { - "version": "0.23.3", + "version": "0.23.4", "title": "Hastructure API", "license": { "name": "BSD 3" diff --git a/test/MainTest.hs b/test/MainTest.hs index 9a9492a1..3e42a7a9 100644 --- a/test/MainTest.hs +++ b/test/MainTest.hs @@ -77,6 +77,7 @@ tests = testGroup "Tests" [AT.mortgageTests ,UtilT.roundingTest ,UtilT.sliceTest ,UtilT.splitTsTest + ,UtilT.tableTest ,AccT.intTests ,AccT.investTests ,AccT.reserveAccTest diff --git a/test/UT/UtilTest.hs b/test/UT/UtilTest.hs index 07c9daaa..07f7a0aa 100644 --- a/test/UT/UtilTest.hs +++ b/test/UT/UtilTest.hs @@ -1,6 +1,6 @@ module UT.UtilTest(daycountTests1,daycountTests2,daycountTests3,daycountTests4 ,tsTest,ts2Test,ts3Test,dateVectorPatternTest,paddingTest,dateSliceTest - ,capTest,roundingTest,sliceTest,splitTsTest)--,daycountTests3,daycountTests4) + ,capTest,roundingTest,sliceTest,splitTsTest,tableTest)--,daycountTests3,daycountTests4) where import Test.Tasty @@ -507,4 +507,28 @@ splitTsTest = assertEqual "" ([CF.CashFlow (toDate "20230901") 10],[CF.CashFlow (toDate "20231001") 10,CF.CashFlow (toDate "20231101") 10]) (splitBy (toDate "20231001") Exc cashflow ) - ] \ No newline at end of file + ] + +tableTest = + let + tbl = ThresholdTable [(5,100),(10,200),(15,300),(20,400)] + in + testGroup "lookup table down" + [ + testCase "down & inclusive" $ + assertEqual "" + [Nothing,Just 100,Just 100] + [lookupTable tbl Down (3 >=),lookupTable tbl Down (5 >=),lookupTable tbl Down (12 >=)] + ,testCase "down & exclusive" $ + assertEqual "" + [Nothing,Nothing,Just 100] + [lookupTable tbl Down (3 >),lookupTable tbl Down (5 >),lookupTable tbl Down (6 >)] + ,testCase "up & inclusive" $ + assertEqual "" + [Nothing,Just 100,Just 100] + [lookupTable tbl Up (3 >=),lookupTable tbl Up (5 >=),lookupTable tbl Up (6 >=)] + ,testCase "up & exclusive" $ + assertEqual "" + [Just 400,Just 300,Just 200,Nothing] + [lookupTable tbl Up (20 >=),lookupTable tbl Up (16 >=),lookupTable tbl Up (11 >=),lookupTable tbl Up (3 >=) ] + ]