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 <always.zhang@gmail>

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)

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

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

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
 

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)