{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Deal.DealAction (performActionWrap,performAction,calcDueFee
                       ,testTrigger,RunContext(..),updateLiqProvider
                       ,calcDueInt,priceAssetUnion
                       ,priceAssetUnionList,inspectVars,inspectListVars) 
  where

import qualified Accounts as A
import qualified Ledger as LD
import qualified Asset as Ast
import qualified Pool as P
import qualified Expense as F
import qualified Liability as L
import qualified CreditEnhancement as CE
import qualified Hedge as HE
import qualified Waterfall as W
import qualified Cashflow as CF
import qualified Assumptions as AP
import qualified AssetClass.AssetBase as ACM
import AssetClass.Mortgage
import AssetClass.Lease
import AssetClass.Loan
import AssetClass.Installment
import AssetClass.MixedAsset

import qualified Call as C
import qualified InterestRate as IR
import qualified Analytics as AN

import Deal.DealBase
import Deal.DealQuery
import Deal.DealDate

import Stmt
import Lib
import Util
import DateUtil
import Types
import Revolving
import Triggers

import qualified Data.Map as Map
import qualified Data.Time as T
import qualified Data.Set as S
import qualified Control.Lens as LS
import Data.List
import qualified Data.DList as DL
import Data.Fixed
import Data.Time.Clock
import Data.Maybe
import Data.Either
import Data.Aeson hiding (json)
import qualified Data.Aeson.Encode.Pretty as Pretty
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import GHC.Generics
import Control.Applicative
import Debug.Trace
import Cashflow (CashFlowFrame(CashFlowFrame))
import Control.Lens hiding (element)
import Control.Lens.TH
import Control.Lens.Extras (is)
import Control.Monad
import GHC.Real (infinity)
import Data.OpenApi (HasPatch(patch))

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

-- ^ Test triggers
testTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Either String Trigger
testTrigger :: forall a.
Asset a =>
TestDeal a -> Date -> Trigger -> Either [Char] Trigger
testTrigger TestDeal a
t Date
d trigger :: Trigger
trigger@Trigger{trgStatus :: Trigger -> Bool
trgStatus=Bool
st,trgCurable :: Trigger -> Bool
trgCurable=Bool
curable,trgCondition :: Trigger -> Pre
trgCondition=Pre
cond,trgStmt :: Trigger -> Maybe Statement
trgStmt = Maybe Statement
tStmt} 
  | Bool -> Bool
not Bool
curable Bool -> Bool -> Bool
&& Bool
st = Trigger -> Either [Char] Trigger
forall a b. b -> Either a b
Right Trigger
trigger
  | Bool
otherwise = let 
                  ([Char]
memo, Either [Char] Bool
newStM) = Date -> TestDeal a -> Pre -> ([Char], Either [Char] Bool)
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> ([Char], Either [Char] Bool)
testPre2 Date
d TestDeal a
t Pre
cond
                in 
                  do 
                    Bool
newSt <- Either [Char] Bool
newStM
                    Trigger -> Either [Char] Trigger
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Trigger
trigger { trgStatus = newSt
                                    , trgStmt = Stmt.appendStmt (TrgTxn d newSt (Stmt.Tag memo)) tStmt }


pricingAssets :: PricingMethod -> [(ACM.AssetUnion,AP.AssetPerf)] -> Maybe [RateAssumption] -> Date 
              -> Either String [PriceResult]
pricingAssets :: PricingMethod
-> [(AssetUnion, AssetPerf)]
-> Maybe [RateAssumption]
-> Date
-> Either [Char] [PriceResult]
pricingAssets PricingMethod
pm [(AssetUnion, AssetPerf)]
assetsAndAssump Maybe [RateAssumption]
ras Date
d 
 = let 
    pricingResults :: [Either [Char] PriceResult]
pricingResults = (\(AssetUnion
ast,AssetPerf
perf) -> AssetUnion
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] PriceResult
priceAssetUnion AssetUnion
ast Date
d PricingMethod
pm AssetPerf
perf Maybe [RateAssumption]
ras) ((AssetUnion, AssetPerf) -> Either [Char] PriceResult)
-> [(AssetUnion, AssetPerf)] -> [Either [Char] PriceResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(AssetUnion, AssetPerf)]
assetsAndAssump
   in
    [Either [Char] PriceResult] -> Either [Char] [PriceResult]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [Either [Char] PriceResult]
pricingResults


-- actual payout amount to bond with due mounts
allocAmtToBonds :: W.PayOrderBy -> Amount -> [(L.Bond,Amount)] -> [(L.Bond,Amount)]
allocAmtToBonds :: PayOrderBy -> Balance -> [(Bond, Balance)] -> [(Bond, Balance)]
allocAmtToBonds PayOrderBy
W.ByProRataCurBal Balance
amt [(Bond, Balance)]
bndsWithDue 
  = [Bond] -> [Balance] -> [(Bond, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Bond, Balance) -> Bond
forall a b. (a, b) -> a
fst ((Bond, Balance) -> Bond) -> [(Bond, Balance)] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bond, Balance)]
bndsWithDue) ([Balance] -> [(Bond, Balance)]) -> [Balance] -> [(Bond, Balance)]
forall a b. (a -> b) -> a -> b
$ [Balance] -> Balance -> [Balance]
prorataFactors ((Bond, Balance) -> Balance
forall a b. (a, b) -> b
snd ((Bond, Balance) -> Balance) -> [(Bond, Balance)] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bond, Balance)]
bndsWithDue) Balance
amt 
allocAmtToBonds PayOrderBy
theOrder Balance
amt [(Bond, Balance)]
bndsWithDue =
  let 
    sortFn :: (Bond, b) -> (Bond, b) -> Ordering
sortFn = case PayOrderBy
theOrder of 
                      PayOrderBy
W.ByName -> (\(Bond
b1,b
_) (Bond
b2,b
_) -> [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Bond -> [Char]
L.bndName Bond
b1) (Bond -> [Char]
L.bndName Bond
b2)) 
                      PayOrderBy
W.ByCurrentRate -> (\(Bond
b1,b
_) (Bond
b2,b
_) -> Micro -> Micro -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Bond -> Micro
L.bndRate Bond
b2) (Bond -> Micro
L.bndRate Bond
b1)) 
                      PayOrderBy
W.ByMaturity -> (\(b1 :: Bond
b1@L.Bond{bndOriginInfo :: Bond -> OriginalInfo
L.bndOriginInfo=OriginalInfo
bo1},b
_) (b2 :: Bond
b2@L.Bond{bndOriginInfo :: Bond -> OriginalInfo
L.bndOriginInfo=OriginalInfo
bo2},b
_) -> Maybe Date -> Maybe Date -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OriginalInfo -> Maybe Date
L.maturityDate OriginalInfo
bo1) (OriginalInfo -> Maybe Date
L.maturityDate OriginalInfo
bo2))
                      PayOrderBy
W.ByStartDate -> (\(b1 :: Bond
b1@L.Bond{bndOriginInfo :: Bond -> OriginalInfo
L.bndOriginInfo=OriginalInfo
bo1},b
_) (b2 :: Bond
b2@L.Bond{bndOriginInfo :: Bond -> OriginalInfo
L.bndOriginInfo=OriginalInfo
bo2},b
_) -> Date -> Date -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OriginalInfo -> Date
L.originDate OriginalInfo
bo1) (OriginalInfo -> Date
L.originDate OriginalInfo
bo2))
                      -- TODO: how to handle if now names found in the bonds
                      -- W.ByCustomNames names -> (\(b1,_) (b2,_) -> compare (findIndex (== (L.bndName b1)) names) (findIndex (== (L.bndName b2)) names))
                      W.ByCustomNames [[Char]]
names -> (\(Bond
b1,b
_) (Bond
b2,b
_) -> Maybe Int -> Maybe Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [[Char]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Bond -> [Char]
L.bndName Bond
b1) [[Char]]
names) ([Char] -> [[Char]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Bond -> [Char]
L.bndName Bond
b2) [[Char]]
names))
    orderedBonds :: [(Bond, Balance)]
orderedBonds = ((Bond, Balance) -> (Bond, Balance) -> Ordering)
-> [(Bond, Balance)] -> [(Bond, Balance)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Bond, Balance) -> (Bond, Balance) -> Ordering
forall {b} {b}. (Bond, b) -> (Bond, b) -> Ordering
sortFn [(Bond, Balance)]
bndsWithDue
    orderedAmt :: [Balance]
orderedAmt = (Bond, Balance) -> Balance
forall a b. (a, b) -> b
snd ((Bond, Balance) -> Balance) -> [(Bond, Balance)] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bond, Balance)]
orderedBonds
  in 
    [Bond] -> [Balance] -> [(Bond, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip 
      ((Bond, Balance) -> Bond
forall a b. (a, b) -> a
fst ((Bond, Balance) -> Bond) -> [(Bond, Balance)] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bond, Balance)]
orderedBonds)
      ([Balance] -> [(Bond, Balance)]) -> [Balance] -> [(Bond, Balance)]
forall a b. (a -> b) -> a -> b
$ Balance -> [Balance] -> [Balance]
paySeqLiabilitiesAmt Balance
amt [Balance]
orderedAmt


calcDueFee :: Ast.Asset a => TestDeal a -> Date -> F.Fee -> Either String F.Fee
calcDueFee :: forall a. Asset a => TestDeal a -> Date -> Fee -> Either [Char] Fee
calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.FixFee Balance
amt) Date
fs Balance
fd Maybe Date
fdDay Balance
fa Maybe Date
_ Maybe Statement
_)
  | Maybe Date -> Bool
forall a. Maybe a -> Bool
isJust Maybe Date
fdDay = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f 
  | Date
calcDay Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
fs Bool -> Bool -> Bool
&& Maybe Date -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Date
fdDay = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f { F.feeDue = amt, F.feeDueDate = Just calcDay} -- `debug` ("DEBUG--> init with amt "++show(fd)++show amt)
  | Bool
otherwise = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.AnnualRateFee DealStats
feeBase DealStats
r) Date
fs Balance
fd Maybe Date
Nothing Balance
fa Maybe Date
lpd Maybe Statement
_)
  | Date
calcDay Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
fs = TestDeal a -> Date -> Fee -> Either [Char] Fee
forall a. Asset a => TestDeal a -> Date -> Fee -> Either [Char] Fee
calcDueFee TestDeal a
t Date
calcDay Fee
f {F.feeDueDate = Just fs }
  | Bool
otherwise = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f 

-- ^ annualized % fee base on pool balance amount
calcDueFee t :: TestDeal a
t@TestDeal{pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pool} Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.AnnualRateFee DealStats
feeBase DealStats
_r) Date
fs Balance
fd (Just Date
_fdDay) Balance
fa Maybe Date
lpd Maybe Statement
_)
  = let 
      accrueStart :: Date
accrueStart = Date
_fdDay
      patchedDs :: DealStats
patchedDs = TestDeal a -> Date -> Date -> DealStats -> DealStats
forall a.
Asset a =>
TestDeal a -> Date -> Date -> DealStats -> DealStats
patchDatesToStats TestDeal a
t Date
accrueStart Date
calcDay DealStats
feeBase
    in 
      do
        Rate
r <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay DealStats
_r 
        Rate
baseBal <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay DealStats
patchedDs
        let newDue :: Rate
newDue = Rate
baseBal Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate
r 
        Fee -> Either [Char] Fee
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Fee
f { F.feeDue=fd+ fromRational newDue, F.feeDueDate = Just calcDay }

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.PctFee DealStats
ds DealStats
_r ) Date
fs Balance
fd Maybe Date
fdDay Balance
fa Maybe Date
lpd Maybe Statement
_)
  = let 
      lastBegDay :: Date
lastBegDay = Date -> Maybe Date -> Date
forall a. a -> Maybe a -> a
fromMaybe Date
fs Maybe Date
fdDay
    in
      do
        Rate
r <-  TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay DealStats
_r
        Rate
baseBal <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay (Date -> DealStats -> DealStats
patchDateToStats Date
calcDay DealStats
ds)
        Fee -> Either [Char] Fee
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Fee
f { F.feeDue = fd + fromRational (baseBal * r), F.feeDueDate = Just calcDay }

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.FeeFlow Ts
ts)  Date
fs Balance
fd Maybe Date
_ Balance
fa Maybe Date
mflpd Maybe Statement
_)
  = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right (Fee -> Either [Char] Fee) -> Fee -> Either [Char] Fee
forall a b. (a -> b) -> a -> b
$
      Fee
f{ F.feeDue = newFeeDue ,F.feeDueDate = Just calcDay ,F.feeType = F.FeeFlow futureDue} 
    where
      (Ts
currentNewDue,Ts
futureDue) = Ts -> Date -> (Ts, Ts)
splitTsByDate Ts
ts Date
calcDay 
      cumulativeDue :: Balance
cumulativeDue = Ts -> Balance
sumValTs Ts
currentNewDue
      newFeeDue :: Balance
newFeeDue =  Balance
cumulativeDue Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
fd  

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.RecurFee DatePattern
p Balance
amt)  Date
fs Balance
fd Maybe Date
mLastAccDate Balance
fa Maybe Date
_ Maybe Statement
_)
  | Int
periodGaps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f 
  | Bool
otherwise = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f { F.feeDue = amt * fromIntegral periodGaps + fd
                        , F.feeDueDate = Just (T.addDays 1 calcDay) }
  where
    accDates :: Dates
accDates = case Maybe Date
mLastAccDate of 
                      Maybe Date
Nothing -> RangeType -> Date -> DatePattern -> Date -> Dates
genSerialDatesTill2 RangeType
NO_IE (Integer -> Date -> Date
T.addDays Integer
1 Date
fs) DatePattern
p Date
calcDay 
                      Just Date
lastAccDate -> RangeType -> Date -> DatePattern -> Date -> Dates
genSerialDatesTill2 RangeType
NO_IE Date
lastAccDate DatePattern
p Date
calcDay 
    periodGaps :: Int
periodGaps = Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
accDates 

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.NumFee DatePattern
p DealStats
s Balance
amt) Date
fs Balance
fd Maybe Date
Nothing Balance
fa Maybe Date
lpd Maybe Statement
_)
  | Date
calcDay Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
fs = TestDeal a -> Date -> Fee -> Either [Char] Fee
forall a. Asset a => TestDeal a -> Date -> Fee -> Either [Char] Fee
calcDueFee TestDeal a
t Date
calcDay Fee
f {F.feeDueDate = Just fs }
  | Bool
otherwise = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f 

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.NumFee DatePattern
p DealStats
s Balance
amt) Date
fs Balance
fd (Just Date
_fdDay) Balance
fa Maybe Date
lpd Maybe Statement
_)
  | Date
_fdDay Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== Date
calcDay = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f 
  | Int
periodGap Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right Fee
f 
  | Bool
otherwise = do 
                  Rate
baseCount <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay (Date -> DealStats -> DealStats
patchDateToStats Date
calcDay DealStats
s)
                  let newFeeDueAmt :: Balance
newFeeDueAmt = (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
baseCount) Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
* Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
* Int -> Balance
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
periodGap -- `debug` ("amt"++show amt++">>"++show baseCount++">>"++show periodGap)
                  Fee -> Either [Char] Fee
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Fee
f { F.feeDue = fd+newFeeDueAmt , F.feeDueDate = Just calcDay } 
  where 
    dueDates :: Dates
dueDates = DatePattern -> Date -> Date -> Dates
projDatesByPattern DatePattern
p Date
_fdDay (Date -> Date
forall a. Enum a => a -> a
pred Date
calcDay)
    periodGap :: Int
periodGap = Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
dueDates  -- `debug` ("Due Dates"++ show dueDates)

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.TargetBalanceFee DealStats
dsDue DealStats
dsPaid) Date
fs Balance
fd Maybe Date
_ Balance
fa Maybe Date
lpd Maybe Statement
_)
  = do 
      let dsDueD :: DealStats
dsDueD = Date -> DealStats -> DealStats
patchDateToStats Date
calcDay DealStats
dsDue 
      let dsPaidD :: DealStats
dsPaidD = Date -> DealStats -> DealStats
patchDateToStats Date
calcDay DealStats
dsPaid
      Rate
dueAmt <- Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
max Rate
0 (Rate -> Rate) -> Either [Char] Rate -> Either [Char] Rate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) (-) (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay DealStats
dsDueD) (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay DealStats
dsPaidD)
      Fee -> Either [Char] Fee
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Fee
f { F.feeDue = fromRational dueAmt, F.feeDueDate = Just calcDay}

calcDueFee t :: TestDeal a
t@TestDeal{ pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pool } Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.ByCollectPeriod Balance
amt) Date
fs Balance
fd Maybe Date
fdday Balance
fa Maybe Date
lpd Maybe Statement
_)
  = Fee -> Either [Char] Fee
forall a b. b -> Either a b
Right (Fee -> Either [Char] Fee) -> Fee -> Either [Char] Fee
forall a b. (a -> b) -> a -> b
$ Fee
f {F.feeDue = dueAmt + fd, F.feeDueDate = Just calcDay}
    where 
      txnsDates :: Dates
txnsDates = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsRow -> Date) -> [TsRow] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Maybe [PoolId] -> [TsRow]
forall a. Asset a => TestDeal a -> Maybe [PoolId] -> [TsRow]
getAllCollectedTxnsList TestDeal a
t ([PoolId] -> Maybe [PoolId]
forall a. a -> Maybe a
Just [PoolId
PoolConsol])
      pastPeriods :: Dates
pastPeriods = case Maybe Date
fdday of 
                      Maybe Date
Nothing ->  RangeType -> Date -> Date -> Dates -> Dates
subDates RangeType
II Date
fs Date
calcDay Dates
txnsDates
                      Just Date
lastFeeDueDay -> RangeType -> Date -> Date -> Dates -> Dates
subDates RangeType
EI Date
lastFeeDueDay Date
calcDay Dates
txnsDates
      dueAmt :: Balance
dueAmt = Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational (Rate -> Balance) -> Rate -> Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Int -> Rate
mulBInt Balance
amt (Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
pastPeriods)

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.AmtByTbl DatePattern
_ DealStats
ds Table Balance Balance
tbl) Date
fs Balance
fd Maybe Date
fdday Balance
fa Maybe Date
lpd Maybe Statement
_)
  = do
      Rate
lookupVal <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay (Date -> DealStats -> DealStats
patchDateToStats Date
calcDay DealStats
ds)
      let dueAmt :: Balance
dueAmt = Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe Balance
0.0 (Maybe Balance -> Balance) -> Maybe Balance -> Balance
forall a b. (a -> b) -> a -> b
$ Table Balance Balance
-> Direction -> (Balance -> Bool) -> Maybe Balance
forall a b.
Ord a =>
Table a b -> Direction -> (a -> Bool) -> Maybe b
lookupTable Table Balance Balance
tbl Direction
Up ( Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
lookupVal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
>=)
      Fee -> Either [Char] Fee
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Fee
f {F.feeDue = dueAmt + fd, F.feeDueDate = Just calcDay}


calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.FeeFlowByPoolPeriod PerCurve Balance
pc) Date
fs Balance
fd Maybe Date
fdday Balance
fa Maybe Date
lpd Maybe Statement
stmt)
  = do 
      Rate
currentPoolPeriod <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay (DealStatFields -> DealStats
DealStatInt DealStatFields
PoolCollectedPeriod)
      Rate
feePaidAmt <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay ([[Char]] -> DealStats
FeePaidAmt [[Char]
fn])
      let dueAmt :: Balance
dueAmt = Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe Balance
0 (Maybe Balance -> Balance) -> Maybe Balance -> Balance
forall a b. (a -> b) -> a -> b
$ PerCurve Balance
-> DateDirection -> CutoffType -> Int -> Maybe Balance
forall a.
PerCurve a -> DateDirection -> CutoffType -> Int -> Maybe a
getValFromPerCurve PerCurve Balance
pc DateDirection
Past CutoffType
Inc (Int -> Int
forall a. Enum a => a -> a
succ (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rate -> Double
forall a. Fractional a => Rate -> a
fromRational Rate
currentPoolPeriod)))
      Fee -> Either [Char] Fee
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Fee
f {F.feeDue = max 0 (dueAmt - fromRational feePaidAmt) + fd, F.feeDueDate = Just calcDay}

calcDueFee TestDeal a
t Date
calcDay f :: Fee
f@(F.Fee [Char]
fn (F.FeeFlowByBondPeriod PerCurve Balance
pc) Date
fs Balance
fd Maybe Date
fdday Balance
fa Maybe Date
lpd Maybe Statement
stmt)
  = do 
      Rate
currentBondPeriod <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay (DealStatFields -> DealStats
DealStatInt DealStatFields
BondPaidPeriod)
      Rate
feePaidAmt <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
calcDay ([[Char]] -> DealStats
FeePaidAmt [[Char]
fn])
      let dueAmt :: Balance
dueAmt = Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe Balance
0 (Maybe Balance -> Balance) -> Maybe Balance -> Balance
forall a b. (a -> b) -> a -> b
$ PerCurve Balance
-> DateDirection -> CutoffType -> Int -> Maybe Balance
forall a.
PerCurve a -> DateDirection -> CutoffType -> Int -> Maybe a
getValFromPerCurve PerCurve Balance
pc DateDirection
Past CutoffType
Inc (Int -> Int
forall a. Enum a => a -> a
succ (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rate -> Double
forall a. Fractional a => Rate -> a
fromRational Rate
currentBondPeriod)))
      Fee -> Either [Char] Fee
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Fee
f {F.feeDue = max 0 (dueAmt - fromRational feePaidAmt) + fd, F.feeDueDate = Just calcDay} 

disableLiqProvider :: Ast.Asset a => TestDeal a -> Date -> CE.LiqFacility -> CE.LiqFacility
disableLiqProvider :: forall a.
Asset a =>
TestDeal a -> Date -> LiqFacility -> LiqFacility
disableLiqProvider TestDeal a
_ Date
d liq :: LiqFacility
liq@CE.LiqFacility{liqEnds :: LiqFacility -> Maybe Date
CE.liqEnds = Just Date
endDate } 
  | Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
endDate = LiqFacility
liq{CE.liqCredit = Just 0}
  | Bool
otherwise = LiqFacility
liq

disableLiqProvider TestDeal a
_ Date
d liq :: LiqFacility
liq@CE.LiqFacility{liqEnds :: LiqFacility -> Maybe Date
CE.liqEnds = Maybe Date
Nothing }  = LiqFacility
liq


-- refresh available balance
---- for Replenish Support and ByPct
updateLiqProvider :: Ast.Asset a => TestDeal a -> Date -> CE.LiqFacility -> CE.LiqFacility
updateLiqProvider :: forall a.
Asset a =>
TestDeal a -> Date -> LiqFacility -> LiqFacility
updateLiqProvider TestDeal a
t Date
d liq :: LiqFacility
liq@CE.LiqFacility{liqType :: LiqFacility -> LiqSupportType
CE.liqType = LiqSupportType
liqType, liqCredit :: LiqFacility -> Maybe Balance
CE.liqCredit = Maybe Balance
curCredit}
  = TestDeal a -> Date -> LiqFacility -> LiqFacility
forall a.
Asset a =>
TestDeal a -> Date -> LiqFacility -> LiqFacility
disableLiqProvider TestDeal a
t Date
d (LiqFacility -> LiqFacility) -> LiqFacility -> LiqFacility
forall a b. (a -> b) -> a -> b
$ LiqFacility
liq { CE.liqCredit = newCredit } 
    where 
      -- TODO ,need to remove due int and due fee
      newCredit :: Maybe Balance
newCredit = case LiqSupportType
liqType of 
                    --  CE.ReplenishSupport _ b -> max b <$> curCredit
                    CE.ByPct DealStats
ds Rate
_r ->  case (Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate
_r) (Rate -> Rate) -> Either [Char] Rate -> Either [Char] Rate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)) of
                                          Left [Char]
y -> Maybe Balance
forall a. Maybe a
Nothing -- TODO tobe fix error
                                          Right Rate
x -> (Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
x)) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
curCredit
                    LiqSupportType
_ -> Maybe Balance
curCredit

-- ^TODO : to be replace from L.accrueInt
-- Not possible to use L.accrueInt, since the interest may use formula to query on deal's stats
calcDueInt :: Ast.Asset a => TestDeal a -> Date -> L.Bond -> Either String L.Bond
calcDueInt :: forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d b :: Bond
b@(L.BondGroup Map [Char] Bond
bMap Maybe BondType
pt) 
  = do 
      Map [Char] Bond
m <- (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d) Map [Char] Bond
bMap 
      Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond -> Maybe BondType -> Bond
L.BondGroup Map [Char] Bond
m Maybe BondType
pt

-- first time to accrue interest\
-- use default date to start to accrue
calcDueInt t :: TestDeal a
t@TestDeal{ status :: forall a. TestDeal a -> DealStatus
status = DealStatus
st} Date
d b :: Bond
b@(L.Bond [Char]
_ BondType
bt OriginalInfo
oi InterestInfo
io Maybe StepUp
_ Balance
bal Micro
r Balance
dp Balance
_ Balance
di Maybe Date
Nothing Maybe Date
_ Maybe Date
_ Maybe Statement
_ ) 
  | Balance
balBalance -> Balance -> Balance
forall a. Num a => a -> a -> a
+Balance
di Balance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
== Balance
0 Bool -> Bool -> Bool
&& (BondType
bt BondType -> BondType -> Bool
forall a. Eq a => a -> a -> Bool
/= BondType
L.IO) = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right Bond
b
  | Bool
otherwise = 
        do 
          Date
sd <- DateDesp -> Either [Char] Date
forall a. DealDates a => a -> Either [Char] Date
getClosingDate (TestDeal a -> DateDesp
forall a. TestDeal a -> DateDesp
dates TestDeal a
t)
          Bond
b' <- TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d (Bond
b {L.bndDueIntDate = Just sd })  -- `debug` ("hit")
          Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Bond
b'

-- Interest Only Bond with Reference Balance
calcDueInt TestDeal a
t Date
d b :: Bond
b@(L.Bond [Char]
_ BondType
L.IO OriginalInfo
oi (L.RefBal DealStats
refBal InterestInfo
ii) Maybe StepUp
_ Balance
bal Micro
r Balance
dp Balance
dInt Balance
dioi (Just Date
lastIntDueDay) Maybe Date
_ Maybe Date
_ Maybe Statement
_ ) 
  = do 
      Rate
balUsed <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d DealStats
refBal -- `debug`  ("Hit acc int"++show d ++" bond name"++ L.bndName b)
      let newDueInt :: Balance
newDueInt = Balance -> Date -> Date -> Micro -> DayCount -> Balance
IR.calcInt (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
balUsed) Date
lastIntDueDay Date
d Micro
r 
                        (DayCount -> Maybe DayCount -> DayCount
forall a. a -> Maybe a -> a
fromMaybe DayCount
DC_ACT_365F (InterestInfo -> Maybe DayCount
L.getDayCountFromInfo InterestInfo
ii)) -- `debug` ("Balused" ++ show (fromRational balUsed) ++ "lastIntDueDay"++show lastIntDueDay ++ "d"++show d ++ "r"++show r)
      Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Bond
b { L.bndDueInt = newDueInt + dInt, L.bndDueIntDate = Just d }

-- Z bond
calcDueInt TestDeal a
t Date
d b :: Bond
b@(L.Bond [Char]
bn BondType
L.Z OriginalInfo
bo InterestInfo
bi Maybe StepUp
_ Balance
bond_bal Micro
bond_rate Balance
_ Balance
_ Balance
_ Maybe Date
_ Maybe Date
lstIntPay Maybe Date
_ Maybe Statement
_) 
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Bond
b {L.bndDueInt = 0 }

-- Won't accrue interest for Equity bond
calcDueInt TestDeal a
t Date
d b :: Bond
b@(L.Bond [Char]
_ BondType
L.Equity OriginalInfo
_ InterestInfo
_ Maybe StepUp
_ Balance
_ Micro
_ Balance
_ Balance
_ Balance
_ Maybe Date
_ Maybe Date
_ Maybe Date
_ Maybe Statement
_)
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right Bond
b 

-- accrued with interest over interest
calcDueInt TestDeal a
t Date
d b :: Bond
b@(L.Bond [Char]
bn BondType
bt OriginalInfo
bo (L.WithIoI InterestInfo
intInfo InterestOverInterestType
ioiIntInfo) Maybe StepUp
_ Balance
bond_bal Micro
bond_rate Balance
_ Balance
intDue Balance
ioiIntDue (Just Date
int_due_date) Maybe Date
lstIntPay Maybe Date
_ Maybe Statement
_ )
  = 
    let
      ioiRate :: Micro
ioiRate = case InterestOverInterestType
ioiIntInfo of 
                  L.OverCurrRateBy Rate
factor -> Micro
bond_rate Micro -> Micro -> Micro
forall a. Num a => a -> a -> a
* Rate -> Micro
forall a. Fractional a => Rate -> a
fromRational (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
+Rate
factor)
                  L.OverFixSpread Micro
spd -> Micro
bond_rate Micro -> Micro -> Micro
forall a. Num a => a -> a -> a
+ Micro
spd
      newIoiInt :: Balance
newIoiInt = Balance -> Date -> Date -> Micro -> DayCount -> Balance
IR.calcInt Balance
intDue Date
int_due_date Date
d Micro
ioiRate DayCount
DC_ACT_365F
      ioiInt :: Balance
ioiInt = Balance
newIoiInt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
ioiIntDue -- add ioi int due with new accrued ioi int
      newBond :: Bond
newBond = Bond
b { L.bndDueIntOverInt = ioiInt, L.bndInterestInfo = intInfo }
    in 
      do 
        Bond
newBondWithIntInfo <- TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d Bond
newBond
        Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Bond
newBondWithIntInfo { L.bndInterestInfo = L.WithIoI intInfo ioiIntInfo}

-- TODO: to enable override rate & balance
-- accure interest by rate
calcDueInt TestDeal a
t Date
d b :: Bond
b@(L.MultiIntBond {}) 
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Date -> Bond -> Bond
L.accrueInt Date
d Bond
b

calcDueInt TestDeal a
t Date
d b :: Bond
b@(L.Bond {})
  = Bond -> Either [Char] Bond
forall a b. b -> Either a b
Right (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Date -> Bond -> Bond
L.accrueInt Date
d Bond
b -- `debug` ("Hit to defualt accru"++ show (L.bndName b)) 


-- ^ modify due principal for bond
calcDuePrin :: Ast.Asset a => TestDeal a -> Date -> L.Bond -> Either String L.Bond
calcDuePrin :: forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDuePrin TestDeal a
t Date
d b :: Bond
b@(L.BondGroup Map [Char] Bond
bMap Maybe BondType
pt) 
  = do 
      Map [Char] Bond
m <- Map [Char] (Either [Char] Bond) -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map [Char] (f a) -> f (Map [Char] a)
sequenceA (Map [Char] (Either [Char] Bond)
 -> Either [Char] (Map [Char] Bond))
-> Map [Char] (Either [Char] Bond)
-> Either [Char] (Map [Char] Bond)
forall a b. (a -> b) -> a -> b
$ (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Map [Char] (Either [Char] Bond)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDuePrin TestDeal a
t Date
d) Map [Char] Bond
bMap
      Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond -> Maybe BondType -> Bond
L.BondGroup Map [Char] Bond
m Maybe BondType
pt

calcDuePrin TestDeal a
t Date
d Bond
b =
  let 
    bondBal :: Balance
bondBal = Bond -> Balance
L.bndBalance Bond
b
  in 
    do
      Balance
tBal <- TestDeal a -> Date -> Bond -> Either [Char] Balance
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Balance
calcBondTargetBalance TestDeal a
t Date
d Bond
b
      Bond -> Either [Char] Bond
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Bond
b {L.bndDuePrin = max 0 (bondBal - tBal) }


priceAssetUnion :: ACM.AssetUnion -> Date -> PricingMethod  -> AP.AssetPerf -> Maybe [RateAssumption] 
                -> Either String PriceResult
priceAssetUnion :: AssetUnion
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] PriceResult
priceAssetUnion (ACM.MO Mortgage
m) Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras = Mortgage
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
forall a.
Asset a =>
a
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
Ast.priceAsset Mortgage
m Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras CutoffType
Inc
priceAssetUnion (ACM.LO Loan
m) Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras = Loan
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
forall a.
Asset a =>
a
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
Ast.priceAsset Loan
m Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras CutoffType
Inc
priceAssetUnion (ACM.IL Installment
m) Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras = Installment
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
forall a.
Asset a =>
a
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
Ast.priceAsset Installment
m Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras CutoffType
Inc
priceAssetUnion (ACM.LS Lease
m) Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras = Lease
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
forall a.
Asset a =>
a
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
Ast.priceAsset Lease
m Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras CutoffType
Inc 
priceAssetUnion (ACM.RE Receivable
m) Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras = Receivable
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
forall a.
Asset a =>
a
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
Ast.priceAsset Receivable
m Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras CutoffType
Inc
priceAssetUnion (ACM.PF ProjectedCashflow
m) Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras = ProjectedCashflow
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
forall a.
Asset a =>
a
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
Ast.priceAsset ProjectedCashflow
m Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras CutoffType
Inc
priceAssetUnion (ACM.FA FixedAsset
m) Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras = FixedAsset
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
forall a.
Asset a =>
a
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> CutoffType
-> Either [Char] PriceResult
Ast.priceAsset FixedAsset
m Date
d PricingMethod
pm AssetPerf
aps Maybe [RateAssumption]
mras CutoffType
Inc

priceAssetUnionList :: [ACM.AssetUnion] -> Date -> PricingMethod  -> AP.ApplyAssumptionType -> Maybe [RateAssumption] 
                    -> Either String [PriceResult]
priceAssetUnionList :: [AssetUnion]
-> Date
-> PricingMethod
-> ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [PriceResult]
priceAssetUnionList [AssetUnion]
assetList Date
d PricingMethod
pm (AP.PoolLevel AssetPerf
assetPerf) Maybe [RateAssumption]
mRates 
  = [Either [Char] PriceResult] -> Either [Char] [PriceResult]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [ AssetUnion
-> Date
-> PricingMethod
-> AssetPerf
-> Maybe [RateAssumption]
-> Either [Char] PriceResult
priceAssetUnion AssetUnion
asset Date
d PricingMethod
pm AssetPerf
assetPerf Maybe [RateAssumption]
mRates | AssetUnion
asset <- [AssetUnion]
assetList ]

-- | this would used in `static` revolving ,which assumes the revolving pool will decrease
splitAssetUnion :: [Rate] -> ACM.AssetUnion -> [ACM.AssetUnion]
splitAssetUnion :: [Rate] -> AssetUnion -> [AssetUnion]
splitAssetUnion [Rate]
rs (ACM.MO Mortgage
m) = [ Mortgage -> AssetUnion
ACM.MO Mortgage
a | Mortgage
a <- Mortgage -> [Rate] -> [Mortgage]
forall a. Asset a => a -> [Rate] -> [a]
Ast.splitWith Mortgage
m [Rate]
rs]
splitAssetUnion [Rate]
rs (ACM.LO Loan
m) = [ Loan -> AssetUnion
ACM.LO Loan
a | Loan
a <- Loan -> [Rate] -> [Loan]
forall a. Asset a => a -> [Rate] -> [a]
Ast.splitWith Loan
m [Rate]
rs]
splitAssetUnion [Rate]
rs (ACM.IL Installment
m) = [ Installment -> AssetUnion
ACM.IL Installment
a | Installment
a <- Installment -> [Rate] -> [Installment]
forall a. Asset a => a -> [Rate] -> [a]
Ast.splitWith Installment
m [Rate]
rs]
splitAssetUnion [Rate]
rs (ACM.LS Lease
m) = [ Lease -> AssetUnion
ACM.LS Lease
a | Lease
a <- Lease -> [Rate] -> [Lease]
forall a. Asset a => a -> [Rate] -> [a]
Ast.splitWith Lease
m [Rate]
rs]
splitAssetUnion [Rate]
rs (ACM.RE Receivable
m) = [ Receivable -> AssetUnion
ACM.RE Receivable
a | Receivable
a <- Receivable -> [Rate] -> [Receivable]
forall a. Asset a => a -> [Rate] -> [a]
Ast.splitWith Receivable
m [Rate]
rs]
splitAssetUnion [Rate]
rs (ACM.FA FixedAsset
m) = [ FixedAsset -> AssetUnion
ACM.FA FixedAsset
a | FixedAsset
a <- FixedAsset -> [Rate] -> [FixedAsset]
forall a. Asset a => a -> [Rate] -> [a]
Ast.splitWith FixedAsset
m [Rate]
rs]

-- ^ return assets bought and pool after bought
buyRevolvingPool :: Date -> Rate -> RevolvingPool -> ([ACM.AssetUnion],RevolvingPool)
buyRevolvingPool :: Date -> Rate -> RevolvingPool -> ([AssetUnion], RevolvingPool)
buyRevolvingPool Date
_ Rate
0 RevolvingPool
rp = ([],RevolvingPool
rp)
buyRevolvingPool Date
_ Rate
r rp :: RevolvingPool
rp@(StaticAsset [AssetUnion]
assets) 
  = let 
      splitRatios :: [Rate]
splitRatios = if Rate
r Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
>= Rate
1 then 
                      [Rate
1.0,Rate
0]
                    else
                      [Rate
r,Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r]
      splitedAssets :: [[AssetUnion]]
splitedAssets = [Rate] -> AssetUnion -> [AssetUnion]
splitAssetUnion [Rate]
splitRatios (AssetUnion -> [AssetUnion]) -> [AssetUnion] -> [[AssetUnion]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssetUnion]
assets
      assetBought :: [AssetUnion]
assetBought = [AssetUnion] -> AssetUnion
forall a. HasCallStack => [a] -> a
head ([AssetUnion] -> AssetUnion) -> [[AssetUnion]] -> [AssetUnion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[AssetUnion]]
splitedAssets
      assetRemains :: [AssetUnion]
assetRemains = [AssetUnion] -> AssetUnion
forall a. HasCallStack => [a] -> a
last ([AssetUnion] -> AssetUnion) -> [[AssetUnion]] -> [AssetUnion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[AssetUnion]]
splitedAssets 
    in 
      ([AssetUnion]
assetBought ,[AssetUnion] -> RevolvingPool
StaticAsset [AssetUnion]
assetRemains)

buyRevolvingPool Date
_ Rate
r rp :: RevolvingPool
rp@(ConstantAsset [AssetUnion]
assets)
  = let 
      splitedAssets :: [[AssetUnion]]
splitedAssets = [Rate] -> AssetUnion -> [AssetUnion]
splitAssetUnion [Rate
r,Rate
0] (AssetUnion -> [AssetUnion]) -> [AssetUnion] -> [[AssetUnion]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssetUnion]
assets
      assetBought :: [AssetUnion]
assetBought = [AssetUnion] -> AssetUnion
forall a. HasCallStack => [a] -> a
head ([AssetUnion] -> AssetUnion) -> [[AssetUnion]] -> [AssetUnion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[AssetUnion]]
splitedAssets
    in 
      ([AssetUnion]
assetBought ,RevolvingPool
rp)

buyRevolvingPool Date
d Rate
r rp :: RevolvingPool
rp@(AssetCurve [TsPoint [AssetUnion]]
aus)
  = let
      splitRatios :: [Rate]
splitRatios = if Rate
r Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
>= Rate
1 then 
                      [Rate
1.0,Rate
0]
                    else
                      [Rate
r,Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r]
      assets :: [AssetUnion]
assets = RevolvingPool -> Date -> [AssetUnion]
lookupAssetAvailable RevolvingPool
rp Date
d 
      splitedAssets :: [[AssetUnion]]
splitedAssets = [Rate] -> AssetUnion -> [AssetUnion]
splitAssetUnion [Rate]
splitRatios (AssetUnion -> [AssetUnion]) -> [AssetUnion] -> [[AssetUnion]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssetUnion]
assets
      assetBought :: [AssetUnion]
assetBought = [AssetUnion] -> AssetUnion
forall a. HasCallStack => [a] -> a
head ([AssetUnion] -> AssetUnion) -> [[AssetUnion]] -> [AssetUnion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[AssetUnion]]
splitedAssets
    in 
      ([AssetUnion]
assetBought, RevolvingPool
rp)


data RunContext a = RunContext{
                  forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow:: Map.Map PoolId CF.PoolCashflow
                  ,forall a.
RunContext a
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
revolvingAssump:: Maybe (Map.Map String (RevolvingPool ,AP.ApplyAssumptionType))
                  ,forall a. RunContext a -> Maybe [RateAssumption]
revolvingInterestRateAssump:: Maybe [RateAssumption]
                  }
                  deriving (Int -> RunContext a -> ShowS
[RunContext a] -> ShowS
RunContext a -> [Char]
(Int -> RunContext a -> ShowS)
-> (RunContext a -> [Char])
-> ([RunContext a] -> ShowS)
-> Show (RunContext a)
forall a. Int -> RunContext a -> ShowS
forall a. [RunContext a] -> ShowS
forall a. RunContext a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> RunContext a -> ShowS
showsPrec :: Int -> RunContext a -> ShowS
$cshow :: forall a. RunContext a -> [Char]
show :: RunContext a -> [Char]
$cshowList :: forall a. [RunContext a] -> ShowS
showList :: [RunContext a] -> ShowS
Show)

updateOriginDate2 :: Date -> ACM.AssetUnion -> ACM.AssetUnion
updateOriginDate2 :: Date -> AssetUnion -> AssetUnion
updateOriginDate2 Date
d (ACM.LO Loan
m) = Loan -> AssetUnion
ACM.LO (Loan -> AssetUnion) -> Loan -> AssetUnion
forall a b. (a -> b) -> a -> b
$ Loan -> Date -> Loan
forall a. Asset a => a -> Date -> a
updateOriginDate Loan
m (Loan -> Date -> Date
forall a. Asset a => a -> Date -> Date
Ast.calcAlignDate Loan
m Date
d)
updateOriginDate2 Date
d (ACM.MO Mortgage
m) = Mortgage -> AssetUnion
ACM.MO (Mortgage -> AssetUnion) -> Mortgage -> AssetUnion
forall a b. (a -> b) -> a -> b
$ Mortgage -> Date -> Mortgage
forall a. Asset a => a -> Date -> a
updateOriginDate Mortgage
m (Mortgage -> Date -> Date
forall a. Asset a => a -> Date -> Date
Ast.calcAlignDate Mortgage
m Date
d)
updateOriginDate2 Date
d (ACM.IL Installment
m) = Installment -> AssetUnion
ACM.IL (Installment -> AssetUnion) -> Installment -> AssetUnion
forall a b. (a -> b) -> a -> b
$ Installment -> Date -> Installment
forall a. Asset a => a -> Date -> a
updateOriginDate Installment
m (Installment -> Date -> Date
forall a. Asset a => a -> Date -> Date
Ast.calcAlignDate Installment
m Date
d)
updateOriginDate2 Date
d (ACM.LS Lease
m) = Lease -> AssetUnion
ACM.LS (Lease -> AssetUnion) -> Lease -> AssetUnion
forall a b. (a -> b) -> a -> b
$ Lease -> Date -> Lease
forall a. Asset a => a -> Date -> a
updateOriginDate Lease
m (Lease -> Date -> Date
forall a. Asset a => a -> Date -> Date
Ast.calcAlignDate Lease
m Date
d)
updateOriginDate2 Date
d (ACM.RE Receivable
m) = Receivable -> AssetUnion
ACM.RE (Receivable -> AssetUnion) -> Receivable -> AssetUnion
forall a b. (a -> b) -> a -> b
$ Receivable -> Date -> Receivable
forall a. Asset a => a -> Date -> a
updateOriginDate Receivable
m (Receivable -> Date -> Date
forall a. Asset a => a -> Date -> Date
Ast.calcAlignDate Receivable
m Date
d)


-- ^ get available supports in balance
evalExtraSupportBalance :: Ast.Asset a => Date -> TestDeal a -> W.ExtraSupport -> Either String Balance
evalExtraSupportBalance :: forall a.
Asset a =>
Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
evalExtraSupportBalance Date
d TestDeal a
t (W.WithCondition Pre
pre ExtraSupport
s) 
  = do
      Bool
flag <- Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
pre
      if Bool
flag then 
        Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
forall a.
Asset a =>
Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
evalExtraSupportBalance Date
d TestDeal a
t ExtraSupport
s
      else
        Balance -> Either [Char] Balance
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Balance
0
evalExtraSupportBalance Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.SupportAccount [Char]
an Maybe BookLedger
_) 
  = Balance -> Either [Char] Balance
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an
evalExtraSupportBalance Date
d t :: TestDeal a
t@TestDeal{liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider=Just Map [Char] LiqFacility
liqMap} (W.SupportLiqFacility [Char]
liqName) 
  = Balance -> Either [Char] Balance
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Balance
1e100
  -- = [ fromMaybe 1e100 (CE.liqCredit (liqMap Map.! liqName))] -- `debug` ("Returning"++ show [ fromMaybe 1e100 (CE.liqCredit (liqMap Map.! liqName))])
  -- = [ fromMaybe (fromRational (toRational infinity)) (CE.liqCredit (liqMap Map.! liqName))] -- `debug` ("Returning"++ show [ fromMaybe 1e100 (CE.liqCredit (liqMap Map.! liqName))])
evalExtraSupportBalance Date
d TestDeal a
t (W.MultiSupport [ExtraSupport]
supports) 
  = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance)
-> Either [Char] [Balance] -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Either [Char] Balance] -> Either [Char] [Balance]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [ (Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
forall a.
Asset a =>
Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
evalExtraSupportBalance Date
d TestDeal a
t ExtraSupport
sp) | ExtraSupport
sp <- [ExtraSupport]
supports ])


-- ^ draw support from a deal , return updated deal,and remaining oustanding amount
drawExtraSupport :: Date -> Amount -> W.ExtraSupport -> TestDeal a -> (TestDeal a, Amount)
-- ^ draw account support and book ledger
drawExtraSupport :: forall a.
Date
-> Balance -> ExtraSupport -> TestDeal a -> (TestDeal a, Balance)
drawExtraSupport Date
d Balance
amt (W.SupportAccount [Char]
an (Just (BookDirection
dr, [Char]
ln))) t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap, ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers= Just Map [Char] Ledger
ledgerMap}
  = let 
      drawAmt :: Balance
drawAmt = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)) Balance
amt
      oustandingAmt :: Balance
oustandingAmt = Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
drawAmt
    in 
      (TestDeal a
t {accounts = Map.adjust (A.draw drawAmt d Types.SupportDraw) an accMap
         ,ledgers = Just $ Map.adjust (LD.entryLog drawAmt d (TxnDirection dr)) ln ledgerMap}
      , Balance
oustandingAmt)

-- ^ draw account support
drawExtraSupport Date
d Balance
amt (W.SupportAccount [Char]
an Maybe BookLedger
Nothing) t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} 
  = let 
      drawAmt :: Balance
drawAmt = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)) Balance
amt
      oustandingAmt :: Balance
oustandingAmt = Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
drawAmt
    in 
      (TestDeal a
t {accounts = Map.adjust (A.draw drawAmt d Types.SupportDraw) an accMap }
      , Balance
oustandingAmt) 

-- ^ draw support from liquidity facility
drawExtraSupport Date
d Balance
amt (W.SupportLiqFacility [Char]
liqName) t :: TestDeal a
t@TestDeal{liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider= Just Map [Char] LiqFacility
liqMap}
  = let
      theLiqProvider :: LiqFacility
theLiqProvider = Map [Char] LiqFacility
liqMap Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
liqName
      drawAmt :: Balance
drawAmt = case LiqFacility -> Maybe Balance
CE.liqCredit LiqFacility
theLiqProvider of 
                  Maybe Balance
Nothing -> Balance
amt -- `debug` ("From amt"++ show amt)
                  Just Balance
b -> Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
amt Balance
b -- `debug` ("From Just"++ show b++">>"++show amt)
      oustandingAmt :: Balance
oustandingAmt = Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
drawAmt -- `debug` ("Draw Amt"++show drawAmt++">>"++ show amt ++">>>")
    in 
      (TestDeal a
t {liqProvider = Just (Map.adjust (CE.draw drawAmt d) liqName liqMap)}
      , Balance
oustandingAmt)

-- ^ draw multiple supports by sequence
drawExtraSupport Date
d Balance
amt (W.MultiSupport [ExtraSupport]
supports) TestDeal a
t
  = (ExtraSupport -> (TestDeal a, Balance) -> (TestDeal a, Balance))
-> (TestDeal a, Balance) -> [ExtraSupport] -> (TestDeal a, Balance)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
      (\ExtraSupport
support (TestDeal a
deal,Balance
remainAmt) -> Date
-> Balance -> ExtraSupport -> TestDeal a -> (TestDeal a, Balance)
forall a.
Date
-> Balance -> ExtraSupport -> TestDeal a -> (TestDeal a, Balance)
drawExtraSupport Date
d Balance
remainAmt ExtraSupport
support TestDeal a
deal) 
      (TestDeal a
t, Balance
amt) 
      [ExtraSupport]
supports

inspectListVars :: Ast.Asset a => TestDeal a -> Date -> [DealStats] -> Either String [ResultComponent]
inspectListVars :: forall a.
Asset a =>
TestDeal a
-> Date -> [DealStats] -> Either [Char] [ResultComponent]
inspectListVars TestDeal a
t Date
d [DealStats]
dss = [Either [Char] ResultComponent] -> Either [Char] [ResultComponent]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [ TestDeal a -> Date -> DealStats -> Either [Char] ResultComponent
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] ResultComponent
inspectVars TestDeal a
t Date
d DealStats
ds | DealStats
ds <- [DealStats]
dss]                     

inspectVars :: Ast.Asset a => TestDeal a -> Date -> DealStats -> Either String ResultComponent
inspectVars :: forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] ResultComponent
inspectVars TestDeal a
t Date
d DealStats
ds =                     
  case DealStats -> DealStatType
getDealStatType DealStats
ds of 
    DealStatType
RtnRate -> do 
                 Rate
q <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                 ResultComponent -> Either [Char] ResultComponent
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultComponent -> Either [Char] ResultComponent)
-> ResultComponent -> Either [Char] ResultComponent
forall a b. (a -> b) -> a -> b
$ Date -> DealStats -> Micro -> ResultComponent
InspectRate Date
d DealStats
ds (Micro -> ResultComponent) -> Micro -> ResultComponent
forall a b. (a -> b) -> a -> b
$ Rate -> Micro
forall a. Fractional a => Rate -> a
fromRational Rate
q
    DealStatType
RtnBool -> do 
                 Bool
q <- TestDeal a -> DealStats -> Date -> Either [Char] Bool
forall a.
Asset a =>
TestDeal a -> DealStats -> Date -> Either [Char] Bool
queryDealBool TestDeal a
t (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds) Date
d
                 ResultComponent -> Either [Char] ResultComponent
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultComponent -> Either [Char] ResultComponent)
-> ResultComponent -> Either [Char] ResultComponent
forall a b. (a -> b) -> a -> b
$ Date -> DealStats -> Bool -> ResultComponent
InspectBool Date
d DealStats
ds Bool
q 
    DealStatType
RtnInt  -> do 
                 Rate
q <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                 ResultComponent -> Either [Char] ResultComponent
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultComponent -> Either [Char] ResultComponent)
-> ResultComponent -> Either [Char] ResultComponent
forall a b. (a -> b) -> a -> b
$ Date -> DealStats -> Int -> ResultComponent
InspectInt Date
d DealStats
ds (Int -> ResultComponent) -> Int -> ResultComponent
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Rate -> Double) -> Rate -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate -> Double
forall a. Fractional a => Rate -> a
fromRational (Rate -> Int) -> Rate -> Int
forall a b. (a -> b) -> a -> b
$ Rate
q
    DealStatType
_       -> do 
                 Rate
q <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                 ResultComponent -> Either [Char] ResultComponent
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultComponent -> Either [Char] ResultComponent)
-> ResultComponent -> Either [Char] ResultComponent
forall a b. (a -> b) -> a -> b
$ Date -> DealStats -> Balance -> ResultComponent
InspectBal Date
d DealStats
ds (Balance -> ResultComponent) -> Balance -> ResultComponent
forall a b. (a -> b) -> a -> b
$ Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
q 

showInspection :: ResultComponent -> String
showInspection :: ResultComponent -> [Char]
showInspection (InspectRate Date
d DealStats
ds Micro
r) = Micro -> [Char]
forall a. Show a => a -> [Char]
show Micro
r
showInspection (InspectBool Date
d DealStats
ds Bool
r) = Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
r
showInspection (InspectInt Date
d DealStats
ds Int
r) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
r
showInspection (InspectBal Date
d DealStats
ds Balance
r) = Balance -> [Char]
forall a. Show a => a -> [Char]
show Balance
r
showInspection ResultComponent
x = ShowS
forall a. HasCallStack => [Char] -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"not implemented for showing ResultComponent " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ResultComponent -> [Char]
forall a. Show a => a -> [Char]
show ResultComponent
x


calcAvailFund :: Ast.Asset a => TestDeal a -> Date -> A.Account -> Maybe W.ExtraSupport -> Either String Balance
calcAvailFund :: forall a.
Asset a =>
TestDeal a
-> Date -> Account -> Maybe ExtraSupport -> Either [Char] Balance
calcAvailFund TestDeal a
t Date
d Account
acc Maybe ExtraSupport
Nothing = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ Account -> Balance
A.accBalance Account
acc
calcAvailFund TestDeal a
t Date
d Account
acc (Just ExtraSupport
support) = ((Account -> Balance
A.accBalance Account
acc) Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+) (Balance -> Balance)
-> Either [Char] Balance -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
forall a.
Asset a =>
Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
evalExtraSupportBalance Date
d TestDeal a
t ExtraSupport
support

-- ^ Deal, Date , cap balance, due balance
applyLimit :: Ast.Asset a => TestDeal a -> Date -> Balance -> Balance -> Maybe Limit -> Either String Balance
applyLimit :: forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
availBal Balance
dueBal Maybe Limit
Nothing = Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availBal Balance
dueBal
applyLimit TestDeal a
t Date
d Balance
availBal Balance
dueBal (Just Limit
limit) = 
    (Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
dueBal) (Balance -> Balance)
-> Either [Char] Balance -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      case Limit
limit of 
        DueCapAmt Balance
amt -> Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
amt Balance
availBal
        DS DealStats
ds -> do 
                    Rate
v <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                    Balance -> Either [Char] Balance
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
v) Balance
availBal)
        DuePct Rate
pct -> Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availBal (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Rate -> Balance
mulBR Balance
dueBal Rate
pct 

        Limit
x -> [Char] -> Either [Char] Balance
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Balance)
-> [Char] -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" Unsupported limit found:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Limit -> [Char]
forall a. Show a => a -> [Char]
show Limit
x

calcAvailAfterLimit :: Ast.Asset a => TestDeal a -> Date -> A.Account -> Maybe W.ExtraSupport 
                    -> Balance -> (Maybe Limit) -> Either String Balance
calcAvailAfterLimit :: forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d Account
acc Maybe ExtraSupport
mSupport Balance
dueAmt Maybe Limit
mLimit 
  = let 
      availFund :: Either [Char] Balance
availFund = case Maybe ExtraSupport
mSupport of 
                    Maybe ExtraSupport
Nothing -> Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> Balance -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ Account -> Balance
A.accBalance Account
acc
                    Just ExtraSupport
support -> ((Account -> Balance
A.accBalance Account
acc) Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+) (Balance -> Balance)
-> Either [Char] Balance -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
forall a.
Asset a =>
Date -> TestDeal a -> ExtraSupport -> Either [Char] Balance
evalExtraSupportBalance Date
d TestDeal a
t ExtraSupport
support
    in
      do
        Balance
r <- (Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
dueAmt) (Balance -> Balance)
-> Either [Char] Balance -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 
               case Maybe Limit
mLimit of
                 Maybe Limit
Nothing -> Either [Char] Balance
availFund
                 Just (DueCapAmt Balance
amt) -> Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
amt (Balance -> Balance)
-> Either [Char] Balance -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Balance
availFund
                 Just (DS DealStats
ds) -> (Balance -> Balance -> Balance)
-> Either [Char] Balance
-> Either [Char] Balance
-> Either [Char] Balance
forall a b c.
(a -> b -> c)
-> Either [Char] a -> Either [Char] b -> Either [Char] c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational (Rate -> Balance) -> Either [Char] Rate -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds))) Either [Char] Balance
availFund
                 Just (DuePct Rate
pct) -> Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Balance -> Rate -> Balance
mulBR Balance
dueAmt Rate
pct) (Balance -> Balance)
-> Either [Char] Balance -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Balance
availFund 
                 Maybe Limit
_ -> [Char] -> Either [Char] Balance
forall a b. a -> Either a b
Left ([Char]
"Failed to find <limit> type"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Limit -> [Char]
forall a. Show a => a -> [Char]
show Maybe Limit
mLimit)
        if Balance
r Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance
0 then
          ([Char] -> Either [Char] Balance
forall a b. a -> Either a b
Left ([Char]
"Negative value when calculates Limit:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Limit -> [Char]
forall a. Show a => a -> [Char]
show Maybe Limit
mLimit[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"but got from availFund"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Either [Char] Balance -> [Char]
forall a. Show a => a -> [Char]
show Either [Char] Balance
availFund))
        else 
          Balance -> Either [Char] Balance
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Balance
r


updateSupport :: Ast.Asset a => Date -> Maybe W.ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport :: forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
_ Maybe ExtraSupport
Nothing Balance
_ TestDeal a
t = TestDeal a
t
updateSupport Date
d (Just ExtraSupport
support) Balance
bal TestDeal a
t = (TestDeal a, Balance) -> TestDeal a
forall a b. (a, b) -> a
fst ((TestDeal a, Balance) -> TestDeal a)
-> (TestDeal a, Balance) -> TestDeal a
forall a b. (a -> b) -> a -> b
$ Date
-> Balance -> ExtraSupport -> TestDeal a -> (TestDeal a, Balance)
forall a.
Date
-> Balance -> ExtraSupport -> TestDeal a -> (TestDeal a, Balance)
drawExtraSupport Date
d Balance
bal ExtraSupport
support TestDeal a
t

performActionWrap :: Ast.Asset a => Date -> (TestDeal a, RunContext a, DL.DList ResultComponent) 
                  -> W.Action -> Either String (TestDeal a, RunContext a, DL.DList ResultComponent)

performActionWrap :: forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs) (W.BuyAsset Maybe Limit
ml PricingMethod
pricingMethod [Char]
accName Maybe PoolId
pId) 
  = Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs) (Maybe Limit
-> PricingMethod
-> [Char]
-> Maybe [Char]
-> Maybe PoolId
-> Action
W.BuyAssetFrom Maybe Limit
ml PricingMethod
pricingMethod [Char]
accName ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"Consol") Maybe PoolId
pId)

performActionWrap Date
d 
                  (t :: TestDeal a
t@TestDeal{ accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accsMap , pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pt}
                  ,rc :: RunContext a
rc@RunContext{runPoolFlow :: forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow=Map PoolId PoolCashflow
pFlowMap
                                ,revolvingAssump :: forall a.
RunContext a
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
revolvingAssump=Just Map [Char] (RevolvingPool, ApplyAssumptionType)
rMap
                                ,revolvingInterestRateAssump :: forall a. RunContext a -> Maybe [RateAssumption]
revolvingInterestRateAssump = Maybe [RateAssumption]
mRates}
                  ,DList ResultComponent
logs)
                  (W.BuyAssetFrom Maybe Limit
ml PricingMethod
pricingMethod [Char]
accName Maybe [Char]
mRevolvingPoolName Maybe PoolId
pId) 
  = 
    let 
      revolvingPoolName :: [Char]
revolvingPoolName = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"Consol" Maybe [Char]
mRevolvingPoolName
      (RevolvingPool
assetForSale::RevolvingPool, ApplyAssumptionType
perfAssumps::AP.ApplyAssumptionType) =  Map [Char] (RevolvingPool, ApplyAssumptionType)
rMap Map [Char] (RevolvingPool, ApplyAssumptionType)
-> [Char] -> (RevolvingPool, ApplyAssumptionType)
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
revolvingPoolName  -- `debug` ("Getting pool"++ revolvingPoolName) 

      _assets :: [AssetUnion]
_assets = RevolvingPool -> Date -> [AssetUnion]
lookupAssetAvailable RevolvingPool
assetForSale Date
d
      assets :: [AssetUnion]
assets = Date -> AssetUnion -> AssetUnion
updateOriginDate2 Date
d (AssetUnion -> AssetUnion) -> [AssetUnion] -> [AssetUnion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssetUnion]
_assets  -- `debug` ("Asset on revolv"++ show _assets)
                
      accBal :: Balance
accBal = Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accsMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
accName 
      pIdToChange :: PoolId
pIdToChange = PoolId -> Maybe PoolId -> PoolId
forall a. a -> Maybe a -> a
fromMaybe PoolId
PoolConsol Maybe PoolId
pId --`debug` ("purchase date"++ show d++ "\n" ++ show assetBought)
    in
      do
        Rate
limitAmt <- case Maybe Limit
ml of 
                      Just (DS DealStats
ds) -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                      Just (DueCapAmt Balance
amt) -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Balance -> Rate
forall a. Real a => a -> Rate
toRational Balance
amt)
                      Just (DuePct Rate
pct) -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate) -> Rate -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ Balance -> Rate
forall a. Real a => a -> Rate
toRational (Balance -> Rate -> Balance
mulBR Balance
accBal Rate
pct)
                      Maybe Limit
Nothing -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Balance -> Rate
forall a. Real a => a -> Rate
toRational Balance
accBal)
        let availBal :: Balance
availBal = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
limitAmt) Balance
accBal  -- `debug` ("Date"++ show d ++" Value on r -asset "++ show valuationOnAvailableAssets)
        [PriceResult]
valOnAvailableAssets <- [AssetUnion]
-> Date
-> PricingMethod
-> ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] [PriceResult]
priceAssetUnionList [AssetUnion]
assets Date
d PricingMethod
pricingMethod ApplyAssumptionType
perfAssumps Maybe [RateAssumption]
mRates 
        let valuationOnAvailableAssets :: Balance
valuationOnAvailableAssets = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ PriceResult -> Balance
getPriceValue (PriceResult -> Balance) -> [PriceResult] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PriceResult]
valOnAvailableAssets
        let purchaseAmt :: Balance
purchaseAmt = case RevolvingPool
assetForSale of 
                            (StaticAsset [AssetUnion]
_) -> Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availBal Balance
valuationOnAvailableAssets -- `debug` ("Valuation on rpool"++show valuationOnAvailableAssets)
                            ConstantAsset [AssetUnion]
_ -> Balance
availBal 
                            AssetCurve [TsPoint [AssetUnion]]
_ -> Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availBal Balance
valuationOnAvailableAssets   
        let purchaseRatio :: Rate
purchaseRatio = Balance -> Balance -> Rate
divideBB Balance
purchaseAmt Balance
valuationOnAvailableAssets -- `debug` ("In Buy >>> Date"++ show d ++ " Purchase Amt"++show purchaseAmt++">> avail value on availAsset"++ show  valuationOnAvailableAssets )
        let ([AssetUnion]
assetBought,RevolvingPool
poolAfterBought) = Date -> Rate -> RevolvingPool -> ([AssetUnion], RevolvingPool)
buyRevolvingPool Date
d (Rate -> Rate
forall a. Real a => a -> Rate
toRational Rate
purchaseRatio) RevolvingPool
assetForSale  -- `debug` ("In Buy >>> date "++ show d ++ "purchase ratio"++ show purchaseRatio)
        let boughtAssetBal :: Balance
boughtAssetBal =  [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ AssetUnion -> Balance
curBal (AssetUnion -> Balance) -> [AssetUnion] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssetUnion]
assetBought  -- `debug` ("In Buy >>> Asset bought 0 \n"++ show assetBought++ "pflow map\n"++ show pFlowMap++" p id to change\n"++ show pIdToChange)
        -- update runtime balance
        let newPt :: PoolType a
newPt = case PoolType a
pt of 
                      MultiPool Map PoolId (Pool a)
pm -> Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool (Map PoolId (Pool a) -> PoolType a)
-> Map PoolId (Pool a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ (Pool a -> Pool a)
-> PoolId -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
                                                    (ASetter
  (Pool a)
  (Pool a)
  (Map CutoffFields Balance)
  (Map CutoffFields Balance)
-> (Map CutoffFields Balance -> Map CutoffFields Balance)
-> Pool a
-> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Pool a)
  (Pool a)
  (Map CutoffFields Balance)
  (Map CutoffFields Balance)
forall a. Asset a => Lens' (Pool a) (Map CutoffFields Balance)
Lens' (Pool a) (Map CutoffFields Balance)
P.poolIssuanceStat ((Balance -> Balance)
-> CutoffFields
-> Map CutoffFields Balance
-> Map CutoffFields Balance
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
boughtAssetBal) CutoffFields
RuntimeCurrentPoolBalance))  
                                                    PoolId
pIdToChange
                                                    Map PoolId (Pool a)
pm
                      ResecDeal Map PoolId (UnderlyingDeal a)
_ -> [Char] -> PoolType a
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implement on buy resec deal"

        let newAccMap :: Map [Char] Account
newAccMap = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
purchaseAmt Date
d ([Char] -> Balance -> TxnComment
PurchaseAsset [Char]
revolvingPoolName Balance
boughtAssetBal)) [Char]
accName Map [Char] Account
accsMap -- `debug` ("Asset bought total bal"++ show boughtAssetBal)
        (CashFlowFrame
cfBought ,Map CutoffFields Balance
_)<- [AssetUnion]
-> Date
-> ApplyAssumptionType
-> Maybe [RateAssumption]
-> Either [Char] (CashFlowFrame, Map CutoffFields Balance)
projAssetUnionList [Date -> AssetUnion -> AssetUnion
updateOriginDate2 Date
d AssetUnion
ast | AssetUnion
ast <- [AssetUnion]
assetBought ] Date
d ApplyAssumptionType
perfAssumps Maybe [RateAssumption]
mRates  -- `debug` ("Date: " ++ show d ++ "Asset bought"++ show [updateOriginDate2 d ast | ast <- assetBought ])
        let newPcf :: Map PoolId PoolCashflow
newPcf = (PoolCashflow -> PoolCashflow)
-> PoolId -> Map PoolId PoolCashflow -> Map PoolId PoolCashflow
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\(cfOrigin :: CashFlowFrame
cfOrigin@(CF.CashFlowFrame BeginStatus
st [TsRow]
trs), Maybe [CashFlowFrame]
mAflow) -> 
                                let 
                                  dsInterval :: Dates
dsInterval = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsRow -> Date) -> [TsRow] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
trs 
                                  boughtCfDates :: Dates
boughtCfDates = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsRow -> Date) -> [TsRow] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [TsRow] CashFlowFrame [TsRow] -> CashFlowFrame -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TsRow] CashFlowFrame [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn CashFlowFrame
cfBought 
                                  newAggDates :: Dates
newAggDates = case (Dates
dsInterval,Dates
boughtCfDates) of 
                                                  ([],[]) -> []
                                                  (Dates
_,[]) -> []
                                                  ([],Dates
_) -> Dates
boughtCfDates
                                                  (Dates
oDs,Dates
bDs) -> 
                                                    let 
                                                      lastOdate :: Date
lastOdate = Dates -> Date
forall a. HasCallStack => [a] -> a
last Dates
oDs
                                                      lastBdate :: Date
lastBdate = Dates -> Date
forall a. HasCallStack => [a] -> a
last Dates
bDs
                                                    in 
                                                      if Date
lastOdate Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
lastBdate then 
                                                        []
                                                      else 
                                                        SliceType -> Dates -> Dates
sliceDates (Date -> SliceType
SliceAfter Date
lastOdate) Dates
bDs
                                  -- TODO: the cfOrigin may not have correct beg balance ,which doesn't match all the amortization of cashflow txn
                                  mergedCf :: CashFlowFrame
mergedCf = CashFlowFrame -> CashFlowFrame -> CashFlowFrame
CF.mergePoolCf2 CashFlowFrame
cfOrigin CashFlowFrame
cfBought 
                                in 
                                  ((ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ([TsRow] -> [TsRow]) -> CashFlowFrame -> CashFlowFrame
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn ([TsRow] -> Dates -> [TsRow]
`CF.aggTsByDates` (Dates
dsInterval Dates -> Dates -> Dates
forall a. [a] -> [a] -> [a]
++ Dates
newAggDates)) CashFlowFrame
mergedCf), ([CashFlowFrame] -> [CashFlowFrame] -> [CashFlowFrame]
forall a. [a] -> [a] -> [a]
++ [CashFlowFrame
cfBought]) ([CashFlowFrame] -> [CashFlowFrame])
-> Maybe [CashFlowFrame] -> Maybe [CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CashFlowFrame]
mAflow)
				) 
                            PoolId
pIdToChange
                            Map PoolId PoolCashflow
pFlowMap

        let newRc :: RunContext a
newRc = RunContext a
rc {runPoolFlow = newPcf  -- `debug` ("In Buy>>>"++show d ++ "New run pool >> \n"++ show newPcf)
                        ,revolvingAssump = Just (Map.insert revolvingPoolName (poolAfterBought, perfAssumps) rMap)} 
        (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t { accounts = newAccMap , pool = newPt}, RunContext a
forall {a}. RunContext a
newRc, DList ResultComponent
logs)

performActionWrap Date
d 
                  (TestDeal a
t
                  ,rc :: RunContext a
rc@RunContext{runPoolFlow :: forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow=Map PoolId PoolCashflow
pcf
                                ,revolvingAssump :: forall a.
RunContext a
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
revolvingAssump=Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
Nothing
                                ,revolvingInterestRateAssump :: forall a. RunContext a -> Maybe [RateAssumption]
revolvingInterestRateAssump=Maybe [RateAssumption]
mRates}
                  ,DList ResultComponent
logs)
                  (W.BuyAsset Maybe Limit
ml PricingMethod
pricingMethod [Char]
accName Maybe PoolId
_)
  = [Char]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a b. a -> Either a b
Left ([Char]
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> [Char]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Missing revolving Assumption(asset assumption & asset to buy)" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TestDeal a -> [Char]
forall a. TestDeal a -> [Char]
name TestDeal a
t

performActionWrap Date
d 
                  (TestDeal a
t
                  ,rc :: RunContext a
rc@RunContext{runPoolFlow :: forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow=Map PoolId PoolCashflow
pcf
                                ,revolvingAssump :: forall a.
RunContext a
-> Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
revolvingAssump=Maybe (Map [Char] (RevolvingPool, ApplyAssumptionType))
Nothing
                                ,revolvingInterestRateAssump :: forall a. RunContext a -> Maybe [RateAssumption]
revolvingInterestRateAssump=Maybe [RateAssumption]
mRates}
                  ,DList ResultComponent
logs)
                  (W.BuyAssetFrom Maybe Limit
_ PricingMethod
_ [Char]
_ Maybe [Char]
_ Maybe PoolId
_)
  = [Char]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a b. a -> Either a b
Left ([Char]
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> [Char]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Missing revolving Assumption(asset assumption & asset to buy)" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TestDeal a -> [Char]
forall a. TestDeal a -> [Char]
name TestDeal a
t
-- TODO need to set a limit to sell
performActionWrap Date
d 
                  (t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accMap, pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pt}  
                  ,rc :: RunContext a
rc@RunContext{runPoolFlow :: forall a. RunContext a -> Map PoolId PoolCashflow
runPoolFlow = Map PoolId PoolCashflow
pcf}
                  ,DList ResultComponent
logs)
                  (W.LiquidatePool PricingMethod
lm [Char]
an Maybe [PoolId]
mPid)
 = let
     liqFunction :: Pool a -> Pool a
liqFunction = \(p :: Pool a
p@P.Pool{ issuanceStat :: forall a. Pool a -> Maybe (Map CutoffFields Balance)
P.issuanceStat = Maybe (Map CutoffFields Balance)
m} ) 
                     -> ASetter (Pool a) (Pool a) CashFlowFrame CashFlowFrame
-> (CashFlowFrame -> CashFlowFrame) -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> Pool a -> Identity (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureScheduleCf ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
 -> Pool a -> Identity (Pool a))
-> ((CashFlowFrame -> Identity CashFlowFrame)
    -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ASetter (Pool a) (Pool a) CashFlowFrame CashFlowFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Identity PoolCashflow)
-> Maybe PoolCashflow -> Identity (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PoolCashflow -> Identity PoolCashflow)
 -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ((CashFlowFrame -> Identity CashFlowFrame)
    -> PoolCashflow -> Identity PoolCashflow)
-> (CashFlowFrame -> Identity CashFlowFrame)
-> Maybe PoolCashflow
-> Identity (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Identity CashFlowFrame)
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1) (Date -> CashFlowFrame -> CashFlowFrame
CF.extendCashFlow Date
d) (Pool a -> Pool a) -> Pool a -> Pool a
forall a b. (a -> b) -> a -> b
$ 
                        ASetter (Pool a) (Pool a) CashFlowFrame CashFlowFrame
-> (CashFlowFrame -> CashFlowFrame) -> Pool a -> Pool a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> Pool a -> Identity (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureCf ((Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
 -> Pool a -> Identity (Pool a))
-> ((CashFlowFrame -> Identity CashFlowFrame)
    -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ASetter (Pool a) (Pool a) CashFlowFrame CashFlowFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Identity PoolCashflow)
-> Maybe PoolCashflow -> Identity (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PoolCashflow -> Identity PoolCashflow)
 -> Maybe PoolCashflow -> Identity (Maybe PoolCashflow))
-> ((CashFlowFrame -> Identity CashFlowFrame)
    -> PoolCashflow -> Identity PoolCashflow)
-> (CashFlowFrame -> Identity CashFlowFrame)
-> Maybe PoolCashflow
-> Identity (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Identity CashFlowFrame)
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1 ) (Date -> CashFlowFrame -> CashFlowFrame
CF.extendCashFlow Date
d) (Pool a -> Pool a) -> Pool a -> Pool a
forall a b. (a -> b) -> a -> b
$ 
                        Pool a
p { P.issuanceStat = Just (Map.insert RuntimeCurrentPoolBalance 0 (fromMaybe Map.empty m)) }

     poolMapToLiq :: Map PoolId (Pool a)
poolMapToLiq = case (PoolType a
pt, Maybe [PoolId]
mPid) of 
                      (MultiPool Map PoolId (Pool a)
pm, Maybe [PoolId]
Nothing) -> Map PoolId (Pool a)
pm
                      (MultiPool Map PoolId (Pool a)
pm,Just [PoolId]
pids) -> let
                                                    selectedPids :: Set PoolId
selectedPids = [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
S.fromList [PoolId]
pids
                                                  in 
                                                    (PoolId -> Pool a -> Bool)
-> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PoolId
k Pool a
v -> PoolId -> Set PoolId -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member PoolId
k Set PoolId
selectedPids) Map PoolId (Pool a)
pm

                      (ResecDeal Map PoolId (UnderlyingDeal a)
_,Maybe [PoolId]
_) -> [Char] -> Map PoolId (Pool a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implement on liquidate resec deal"



     liqAmtByPool :: Map PoolId Balance
liqAmtByPool = (PoolId -> Pool a -> Balance)
-> Map PoolId (Pool a) -> Map PoolId Balance
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\PoolId
k Pool a
p -> Date -> Pool a -> PoolCashflow -> PricingMethod -> Balance
forall a.
Asset a =>
Date -> Pool a -> PoolCashflow -> PricingMethod -> Balance
P.pricingPoolFlow Date
d Pool a
p (Map PoolId PoolCashflow
pcf Map PoolId PoolCashflow -> PoolId -> PoolCashflow
forall k a. Ord k => Map k a -> k -> a
Map.! PoolId
k) PricingMethod
lm) Map PoolId (Pool a)
poolMapToLiq -- `debug` ("pool id to liq"++ show poolMapToLiq)
     liqAmt :: Balance
liqAmt = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ Map PoolId Balance -> [Balance]
forall k a. Map k a -> [a]
Map.elems Map PoolId Balance
liqAmtByPool

     -- Update collected cashflow
     newPt :: PoolType a
newPt = case (PoolType a
pt, Maybe [PoolId]
mPid) of 
               (MultiPool Map PoolId (Pool a)
pm, Maybe [PoolId]
Nothing) -> Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool (Map PoolId (Pool a) -> PoolType a)
-> Map PoolId (Pool a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ (Pool a -> Pool a) -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Pool a -> Pool a
liqFunction Map PoolId (Pool a)
pm
               (MultiPool Map PoolId (Pool a)
pm, Just [PoolId]
pids) -> let
                                              selectedPids :: Set PoolId
selectedPids = [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
S.fromList [PoolId]
pids
                                              selectedPoolMap :: Map PoolId (Pool a)
selectedPoolMap = (PoolId -> Pool a -> Bool)
-> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PoolId
k Pool a
v -> PoolId -> Set PoolId -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member PoolId
k Set PoolId
selectedPids) Map PoolId (Pool a)
pm
                                            in 
                                              Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool (Map PoolId (Pool a) -> PoolType a)
-> Map PoolId (Pool a) -> PoolType a
forall a b. (a -> b) -> a -> b
$ Map PoolId (Pool a) -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ((Pool a -> Pool a) -> Map PoolId (Pool a) -> Map PoolId (Pool a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Pool a -> Pool a
liqFunction Map PoolId (Pool a)
selectedPoolMap) Map PoolId (Pool a)
pm
               (ResecDeal Map PoolId (UnderlyingDeal a)
_,Maybe [PoolId]
_) -> [Char] -> PoolType a
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implement on liquidate resec deal"

     liqComment :: TxnComment
liqComment = [PoolId] -> TxnComment
LiquidationProceeds ([PoolId] -> Maybe [PoolId] -> [PoolId]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [PoolId]
mPid)
     accMapAfterLiq :: Map [Char] Account
accMapAfterLiq = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
liqAmt Date
d TxnComment
liqComment) [Char]
an Map [Char] Account
accMap
     -- REMOVE future cf
     newPfInRc :: Map PoolId PoolCashflow
newPfInRc = (PoolId -> Map PoolId PoolCashflow -> Map PoolId PoolCashflow)
-> Map PoolId PoolCashflow -> [PoolId] -> Map PoolId PoolCashflow
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((PoolCashflow -> PoolCashflow)
-> PoolId -> Map PoolId PoolCashflow -> Map PoolId PoolCashflow
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (ASetter PoolCashflow PoolCashflow [TsRow] [TsRow]
-> [TsRow] -> PoolCashflow -> PoolCashflow
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CashFlowFrame -> Identity CashFlowFrame)
-> PoolCashflow -> Identity PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1 ((CashFlowFrame -> Identity CashFlowFrame)
 -> PoolCashflow -> Identity PoolCashflow)
-> ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
-> ASetter PoolCashflow PoolCashflow [TsRow] [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter CashFlowFrame CashFlowFrame [TsRow] [TsRow]
Lens' CashFlowFrame [TsRow]
CF.cashflowTxn) [])) Map PoolId PoolCashflow
pcf  (Map PoolId (Pool a) -> [PoolId]
forall k a. Map k a -> [k]
Map.keys Map PoolId (Pool a)
poolMapToLiq)
     -- Update current balance to zero 
   in
     (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t {accounts = accMapAfterLiq , pool = newPt} , RunContext a
rc {runPoolFlow = newPfInRc}, DList ResultComponent
logs)


performActionWrap Date
d (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs) (W.WatchVal Maybe [Char]
ms [DealStats]
dss)
  = (TestDeal a
-> Date -> [DealStats] -> Either [Char] [ResultComponent]
forall a.
Asset a =>
TestDeal a
-> Date -> [DealStats] -> Either [Char] [ResultComponent]
inspectListVars TestDeal a
t Date
d [DealStats]
dss) Either [Char] [ResultComponent]
-> ([ResultComponent]
    -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[ResultComponent]
vs -> (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a b. b -> Either a b
Right (TestDeal a
t, RunContext a
rc, DList ResultComponent -> ResultComponent -> DList ResultComponent
forall a. DList a -> a -> DList a
DL.snoc DList ResultComponent
logs (Date -> Maybe [Char] -> [DealStats] -> [[Char]] -> ResultComponent
InspectWaterfall Date
d Maybe [Char]
ms [DealStats]
dss (ResultComponent -> [Char]
showInspection (ResultComponent -> [Char]) -> [ResultComponent] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultComponent]
vs)))) 


performActionWrap Date
d (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs) (W.ActionWithPre Pre
p [Action]
actions) 
  = do 
      Bool
flag <- Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
p 
      if Bool
flag then 
        ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t,RunContext a
rc,DList ResultComponent
logs) [Action]
actions
      else
        (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs)


performActionWrap Date
d (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs) (W.ActionWithPre2 Pre
p [Action]
actionsTrue [Action]
actionsFalse) 
  = do 
      Bool
flag <- Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
p
      if Bool
flag then
        ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t,RunContext a
rc,DList ResultComponent
logs) [Action]
actionsTrue
      else
        ((TestDeal a, RunContext a, DList ResultComponent)
 -> Action
 -> Either [Char] (TestDeal a, RunContext a, DList ResultComponent))
-> (TestDeal a, RunContext a, DList ResultComponent)
-> [Action]
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a.
Asset a =>
Date
-> (TestDeal a, RunContext a, DList ResultComponent)
-> Action
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
performActionWrap Date
d) (TestDeal a
t,RunContext a
rc,DList ResultComponent
logs) [Action]
actionsFalse


performActionWrap Date
d (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs) (W.ChangeStatus Maybe Pre
mPre DealStatus
newSt) 
  = case Maybe Pre
mPre of
      Maybe Pre
Nothing -> (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t {status=newSt} , RunContext a
rc, DList ResultComponent
logs)
      Just Pre
p -> 
        do 
          Bool
flag <- Date -> TestDeal a -> Pre -> Either [Char] Bool
forall a.
Asset a =>
Date -> TestDeal a -> Pre -> Either [Char] Bool
testPre Date
d TestDeal a
t Pre
p
          if Bool
flag then
            (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t {status=newSt} , RunContext a
rc, DList ResultComponent
logs)
          else 
            (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs)

-- ^ go down to performAction
performActionWrap Date
d (TestDeal a
t, RunContext a
rc, DList ResultComponent
logs) Action
a 
  = do 
      TestDeal a
dealAfterExe <- Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
t Action
a 
      (TestDeal a, RunContext a, DList ResultComponent)
-> Either [Char] (TestDeal a, RunContext a, DList ResultComponent)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a
dealAfterExe, RunContext a
rc, DList ResultComponent
logs)

performAction :: Ast.Asset a => Date -> TestDeal a -> W.Action -> Either String (TestDeal a)
performAction :: forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap, ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers = Just Map [Char] Ledger
ledgerM} 
                (W.TransferAndBook Maybe Limit
mLimit [Char]
an1 [Char]
an2 (BookDirection
dr, [Char]
lName) Maybe TxnComment
mComment)
  = let
      sourceAcc :: Account
sourceAcc = Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an1
      targetAcc :: Account
targetAcc = Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an2 
      actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an1) Maybe ExtraSupport
forall a. Maybe a
Nothing (Account -> Balance
A.accBalance Account
sourceAcc) Maybe Limit
mLimit
    in 
      do 
        Balance
transferAmt <- Either [Char] Balance
actualPaidOut
        let accMapAfterDraw :: Map [Char] Account
accMapAfterDraw = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
transferAmt Date
d ([TxnComment] -> TxnComment
TxnComments [[Char] -> [Char] -> TxnComment
Transfer [Char]
an1 [Char]
an2,(BookDirection -> [Char] -> TxnComment
BookLedgerBy BookDirection
dr [Char]
lName)])) [Char]
an1 Map [Char] Account
accMap -- `debug` (">>PDL >>Ledger bal"++show d ++ show targetAmt)
        let accMapAfterDeposit :: Map [Char] Account
accMapAfterDeposit = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
transferAmt Date
d ([TxnComment] -> TxnComment
TxnComments [[Char] -> [Char] -> TxnComment
Transfer [Char]
an1 [Char]
an2,(BookDirection -> [Char] -> TxnComment
BookLedgerBy BookDirection
dr [Char]
lName)])) [Char]
an2 Map [Char] Account
accMapAfterDraw
        let newLedgerM :: Map [Char] Ledger
newLedgerM = (Ledger -> Ledger)
-> [Char] -> Map [Char] Ledger -> Map [Char] Ledger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Ledger -> Ledger
LD.entryLog Balance
transferAmt Date
d (BookDirection -> TxnComment
TxnDirection BookDirection
dr)) [Char]
lName Map [Char] Ledger
ledgerM
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t {accounts = accMapAfterDeposit, ledgers = Just newLedgerM}  

performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.Transfer Maybe Limit
mLimit [Char]
an1 [Char]
an2 Maybe TxnComment
mComment)
  = let
      sourceAcc :: Account
sourceAcc = Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an1
      targetAcc :: Account
targetAcc = Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an2 
      actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an1) Maybe ExtraSupport
forall a. Maybe a
Nothing (Account -> Balance
A.accBalance Account
sourceAcc) Maybe Limit
mLimit
    in 
      do 
        Balance
transferAmt <- Either [Char] Balance
actualPaidOut
        let accMapAfterDraw :: Map [Char] Account
accMapAfterDraw = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
transferAmt Date
d ([Char] -> [Char] -> TxnComment
Transfer [Char]
an1 [Char]
an2)) [Char]
an1 Map [Char] Account
accMap -- `debug` (">>PDL >>Ledger bal"++show d ++ show targetAmt)
        let accMapAfterDeposit :: Map [Char] Account
accMapAfterDeposit = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
transferAmt Date
d ([Char] -> [Char] -> TxnComment
Transfer [Char]
an1 [Char]
an2)) [Char]
an2 Map [Char] Account
accMapAfterDraw
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t {accounts = accMapAfterDeposit}  

performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.TransferMultiple [(Maybe Limit, [Char])]
sourceAccList [Char]
targetAcc Maybe TxnComment
mComment)
  = (TestDeal a -> (Maybe Limit, [Char]) -> Either [Char] (TestDeal a))
-> TestDeal a
-> [(Maybe Limit, [Char])]
-> Either [Char] (TestDeal a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\TestDeal a
acc (Maybe Limit
mLimit, [Char]
sourceAccName) -> 
            Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
acc (Maybe Limit -> [Char] -> [Char] -> Maybe TxnComment -> Action
W.Transfer Maybe Limit
mLimit [Char]
sourceAccName [Char]
targetAcc Maybe TxnComment
mComment))
          TestDeal a
t
          [(Maybe Limit, [Char])]
sourceAccList  

-- ^ book ledger 
performAction Date
d t :: TestDeal a
t@TestDeal{ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers= Just Map [Char] Ledger
ledgerM} (W.BookBy (W.Till [Char]
ledger BookDirection
dr DealStats
ds)) =
  do
    Rate
targetAmt <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d DealStats
ds
    let (BookDirection
bookDirection, Balance
amtToBook) = Ledger -> (BookDirection, Balance) -> (BookDirection, Balance)
LD.bookToTarget (Map [Char] Ledger
ledgerM Map [Char] Ledger -> [Char] -> Ledger
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
ledger) (BookDirection
dr, Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
targetAmt)
    let newLedgerM :: Map [Char] Ledger
newLedgerM = (Ledger -> Ledger)
-> [Char] -> Map [Char] Ledger -> Map [Char] Ledger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (BookDirection
-> Balance -> Date -> Maybe TxnComment -> Ledger -> Ledger
LD.entryLogByDr BookDirection
bookDirection Balance
amtToBook Date
d Maybe TxnComment
forall a. Maybe a
Nothing) [Char]
ledger Map [Char] Ledger
ledgerM
    TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {ledgers = Just newLedgerM } 

performAction Date
d t :: TestDeal a
t@TestDeal{ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers= Just Map [Char] Ledger
ledgerM} (W.BookBy (W.ByDS [Char]
ledger BookDirection
dr DealStats
ds)) =
  do
    Rate
amtToBook <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d DealStats
ds
    let newLedgerM :: Map [Char] Ledger
newLedgerM = (Ledger -> Ledger)
-> [Char] -> Map [Char] Ledger -> Map [Char] Ledger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (BookDirection
-> Balance -> Date -> Maybe TxnComment -> Ledger -> Ledger
LD.entryLogByDr BookDirection
dr (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
amtToBook) Date
d Maybe TxnComment
forall a. Maybe a
Nothing) [Char]
ledger Map [Char] Ledger
ledgerM
    TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {ledgers = Just newLedgerM } 

-- ^ it will book ledgers by order with mandatory caps which describes by a <formula> 
-- ^ ds -> value to book 
-- ^ ledgersList -> list of ledgers to book 
performAction Date
d t :: TestDeal a
t@TestDeal{ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers= Just Map [Char] Ledger
ledgerM} (W.BookBy (W.PDL BookDirection
dr DealStats
ds [([Char], DealStats)]
ledgersList)) =
  let
    ledgerCaps :: Either [Char] [Rate]
ledgerCaps = [Either [Char] Rate] -> Either [Char] [Rate]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [ TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d DealStats
ledgerCap | DealStats
ledgerCap <- ([Char], DealStats) -> DealStats
forall a b. (a, b) -> b
snd (([Char], DealStats) -> DealStats)
-> [([Char], DealStats)] -> [DealStats]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], DealStats)]
ledgersList ]
    ledgerNames :: [[Char]]
ledgerNames = ([Char], DealStats) -> [Char]
forall a b. (a, b) -> a
fst (([Char], DealStats) -> [Char])
-> [([Char], DealStats)] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], DealStats)]
ledgersList
  in 
    do
      Rate
amtToBook <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d DealStats
ds
      [Rate]
ledgCaps <- Either [Char] [Rate]
ledgerCaps
      let amtBookedToLedgers :: [Balance]
amtBookedToLedgers = Balance -> [Balance] -> [Balance]
paySeqLiabilitiesAmt (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
amtToBook) (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational (Rate -> Balance) -> [Rate] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
ledgCaps) --`debug` ("amt to book"++ show amtToBook)
      let newLedgerM :: Map [Char] Ledger
newLedgerM = (([Char], Balance) -> Map [Char] Ledger -> Map [Char] Ledger)
-> Map [Char] Ledger -> [([Char], Balance)] -> Map [Char] Ledger
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
                         (\([Char]
ln,Balance
amt) Map [Char] Ledger
acc -> (Ledger -> Ledger)
-> [Char] -> Map [Char] Ledger -> Map [Char] Ledger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (BookDirection
-> Balance -> Date -> Maybe TxnComment -> Ledger -> Ledger
LD.entryLogByDr BookDirection
dr Balance
amt Date
d Maybe TxnComment
forall a. Maybe a
Nothing) [Char]
ln Map [Char] Ledger
acc)
                         Map [Char] Ledger
ledgerM
                         ([[Char]] -> [Balance] -> [([Char], Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
ledgerNames [Balance]
amtBookedToLedgers) --`debug` ("amts to book"++ show amtBookedToLedgers)
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {ledgers = Just newLedgerM}

-- ^ pay fee sequentially, but not accrued
performAction Date
d t :: TestDeal a
t@TestDeal{fees :: forall a. TestDeal a -> Map [Char] Fee
fees=Map [Char] Fee
feeMap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayFeeBySeq Maybe Limit
mLimit [Char]
an [[Char]]
fns Maybe ExtraSupport
mSupport) =
  let 
    availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
    feesToPay :: [Fee]
feesToPay = ([Char] -> Fee) -> [[Char]] -> [Fee]
forall a b. (a -> b) -> [a] -> [b]
map (Map [Char] Fee
feeMap Map [Char] Fee -> [Char] -> Fee
forall k a. Ord k => Map k a -> k -> a
Map.!) [[Char]]
fns
    totalFeeDue :: Balance
totalFeeDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ (Fee -> Balance) -> [Fee] -> [Balance]
forall a b. (a -> b) -> [a] -> [b]
map Fee -> Balance
F.feeDue [Fee]
feesToPay
    actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalFeeDue Maybe Limit
mLimit
  in
    do 
      Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
      let ([Fee]
feesPaid, Balance
remainAmt) = Date
-> Balance
-> (Fee -> Balance)
-> (Balance -> Fee -> Fee)
-> [Fee]
-> [Fee]
-> ([Fee], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
paySequentially Date
d Balance
paidOutAmt Fee -> Balance
F.feeDue (Date -> Balance -> Fee -> Fee
F.payFee Date
d) [] [Fee]
feesToPay
      let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
    
      let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap
                           ,fees = Map.fromList (zip fns feesPaid) <> feeMap}

      let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc
    
-- ^ pay out fee in pro-rata fashion
performAction Date
d t :: TestDeal a
t@TestDeal{fees :: forall a. TestDeal a -> Map [Char] Fee
fees=Map [Char] Fee
feeMap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayFee Maybe Limit
mLimit [Char]
an [[Char]]
fns Maybe ExtraSupport
mSupport) =
  let 
    availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
    feesToPay :: [Fee]
feesToPay = ([Char] -> Fee) -> [[Char]] -> [Fee]
forall a b. (a -> b) -> [a] -> [b]
map (Map [Char] Fee
feeMap Map [Char] Fee -> [Char] -> Fee
forall k a. Ord k => Map k a -> k -> a
Map.!) [[Char]]
fns
    totalFeeDue :: Balance
totalFeeDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ (Fee -> Balance) -> [Fee] -> [Balance]
forall a b. (a -> b) -> [a] -> [b]
map Fee -> Balance
F.feeDue [Fee]
feesToPay
    actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalFeeDue Maybe Limit
mLimit
  in
    do 
      Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
      let ([Fee]
feesPaid, Balance
remainAmt) = Date
-> Balance
-> (Fee -> Balance)
-> (Balance -> Fee -> Fee)
-> [Fee]
-> ([Fee], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
paidOutAmt Fee -> Balance
F.feeDue (Date -> Balance -> Fee -> Fee
F.payFee Date
d) [Fee]
feesToPay
      let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
    
      let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap
                           ,fees = Map.fromList (zip fns feesPaid) <> feeMap}

      let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc


performAction Date
d TestDeal a
t (W.AccrueAndPayIntBySeq Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)
  = do
      TestDeal a
dealWithBondDue <- Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
t ([[Char]] -> Action
W.CalcBondInt [[Char]]
bnds)
      Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
dealWithBondDue (Maybe Limit -> [Char] -> [[Char]] -> Maybe ExtraSupport -> Action
W.PayIntBySeq Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap, liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider=Maybe (Map [Char] LiqFacility)
liqMap} 
                (W.PayIntOverIntBySeq Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)
  = let 
      availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
      bndsList :: [Bond]
bndsList = Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bnds
      dueAmts :: [Balance]
dueAmts = Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getDueIntOverInt (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsList
      totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
dueAmts
      actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
    in
      do 
        Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
        let ([Bond]
bondsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
paySequentially Date
d Balance
paidOutAmt Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getDueIntOverInt (Date -> Balance -> Bond -> Bond
L.payInt Date
d) [] [Bond]
bndsList
        let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
      
        let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap
                             ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap}

        let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc


performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap, liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider=Maybe (Map [Char] LiqFacility)
liqMap} 
              (W.PayIntBySeq Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)
   = let 
      availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
      bndsList :: [Bond]
bndsList = Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bnds
      dueAmts :: [Balance]
dueAmts = Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsList
      totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
dueAmts
      actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
    in
      do 
        Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
        let ([Bond]
bondsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
paySequentially Date
d Balance
paidOutAmt Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt (Date -> Balance -> Bond -> Bond
L.payInt Date
d) [] [Bond]
bndsList
        let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
      
        let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap
                             ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap}

        let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc


performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} 
              (W.PayIntOverInt Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)
   = let 
       availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
       bndsList :: [Bond]
bndsList = Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bnds
       dueAmts :: [Balance]
dueAmts = Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getDueIntOverInt (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsList
       totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
dueAmts
       actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
     in
       do
         Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
         let ([Bond]
bondsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
paidOutAmt Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getDueIntOverInt (Date -> Balance -> Bond -> Bond
L.payInt Date
d) [Bond]
bndsList
         let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
       
         let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap
                              ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap}

         let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
         TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} 
              (W.PayInt Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)
  = let 
     availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
     bndsList :: [Bond]
bndsList = Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bnds
     dueAmts :: [Balance]
dueAmts = Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsList
     totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
dueAmts
     actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
   in
     do
       Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
       let ([Bond]
bondsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
paidOutAmt Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt (Date -> Balance -> Bond -> Bond
L.payInt Date
d) [Bond]
bndsList
       let accPaidOut :: Balance
accPaidOut = (Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt)
     
       let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap
                            ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap}

       let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
       TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap,ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers= Just Map [Char] Ledger
ledgerM} 
                (W.PayIntAndBook Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport (BookDirection
dr, [Char]
lName))
  = let 
     availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
     bndsList :: [Bond]
bndsList = Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bnds
     dueAmts :: [Balance]
dueAmts = Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsList
     totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
dueAmts
     actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
   in
     do
       Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
       let ([Bond]
bondsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
paidOutAmt Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt (Date -> Balance -> Bond -> Bond
L.payInt Date
d) [Bond]
bndsList
       let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
       let newLedgerM :: Map [Char] Ledger
newLedgerM = (Ledger -> Ledger)
-> [Char] -> Map [Char] Ledger -> Map [Char] Ledger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (BookDirection
-> Balance -> Date -> Maybe TxnComment -> Ledger -> Ledger
LD.entryLogByDr BookDirection
dr Balance
paidOutAmt Date
d Maybe TxnComment
forall a. Maybe a
Nothing) [Char]
lName Map [Char] Ledger
ledgerM
     
       let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayInt bnds)) an accMap
                            ,bonds = Map.fromList (zip bnds bondsPaid) <> bndMap
                            ,ledgers = Just newLedgerM}

       let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
       TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc



performAction Date
d TestDeal a
t (W.AccrueAndPayInt Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport) =
  do
    TestDeal a
dealWithBondDue <- Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
t ([[Char]] -> Action
W.CalcBondInt [[Char]]
bnds)
    Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
dealWithBondDue (Maybe Limit -> [Char] -> [[Char]] -> Maybe ExtraSupport -> Action
W.PayInt Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)

performAction Date
d TestDeal a
t (W.CalcAndPayFee Maybe Limit
mLimit [Char]
ans [[Char]]
fees Maybe ExtraSupport
mSupport) =
  do
    TestDeal a
dealWithFeeDue <- Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
t ([[Char]] -> Action
W.CalcFee [[Char]]
fees)
    Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
dealWithFeeDue (Maybe Limit -> [Char] -> [[Char]] -> Maybe ExtraSupport -> Action
W.PayFee Maybe Limit
mLimit [Char]
ans [[Char]]
fees Maybe ExtraSupport
mSupport)

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayIntResidual Maybe Limit
mLimit [Char]
an [Char]
bndName) =
  let 
    availBal :: Balance
availBal = Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an
  in
    do 
      Balance
limitAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
availBal Balance
availBal Maybe Limit
mLimit
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {accounts = Map.adjust (A.draw limitAmt d (PayYield bndName)) an accMap
                 , bonds = Map.adjust (L.payYield d limitAmt) bndName bndMap}


-- TODO check for multi interest bond
performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayIntByRateIndex Maybe Limit
mLimit [Char]
an [[Char]]
bndNames Int
idx Maybe ExtraSupport
mSupport)
  = let 
      availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
      bndsList :: [Bond]
bndsList = (Bond -> Bool) -> [Bond] -> [Bond]
forall a. (a -> Bool) -> [a] -> [a]
filter (APrism
  Bond
  Bond
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
-> Bond -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism
  Bond
  Bond
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
Prism'
  Bond
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
L._MultiIntBond) ([Bond] -> [Bond]) -> [Bond] -> [Bond]
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bndNames
      bndNames_ :: [[Char]]
bndNames_ = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsList
    in 
      do 
        Rate
totalDue <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Int -> [[Char]] -> DealStats
CurrentDueBondIntTotalAt Int
idx [[Char]]
bndNames_)
        Balance
actualPaidOut <- TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
totalDue) Maybe Limit
mLimit -- `debug` ("Date "++ show d ++" total due"++show (fromRational totalDue))
        let ([Bond]
paidBonds, Balance
_) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
actualPaidOut (Bond -> Int -> Balance
forall lb. Liable lb => lb -> Int -> Balance
`L.getTotalDueIntAt` Int
idx) (Date -> Int -> Balance -> Bond -> Bond
L.payIntByIndex Date
d Int
idx) [Bond]
bndsList -- `debug` ("Date"++show d++" paid out amt"++show (L.bndDueInts (paidBonds!!0)))
        let accMap1 :: Map [Char] Account
accMap1 = Map [Char] Account
accMap -- `debug` ("Date"++show d++" paid out amt"++show (L.bndDueInts (paidBonds!!0)))
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {accounts = Map.adjust (A.draw actualPaidOut d (PayInt bndNames_)) an accMap1
                   , bonds =  Map.fromList (zip bndNames_ paidBonds) <> bndMap}


performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayIntByRateIndexBySeq Maybe Limit
mLimit [Char]
an [[Char]]
bndNames Int
idx Maybe ExtraSupport
mSupport)
  = let 
      availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
      bndsList :: [Bond]
bndsList = (Bond -> Bool) -> [Bond] -> [Bond]
forall a. (a -> Bool) -> [a] -> [a]
filter (APrism
  Bond
  Bond
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
-> Bond -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism
  Bond
  Bond
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
Prism'
  Bond
  ([Char], BondType, OriginalInfo, [InterestInfo], Maybe [StepUp],
   Balance, [Micro], Balance, [Balance], [Balance], Maybe Date,
   Maybe Dates, Maybe Date, Maybe Statement)
L._MultiIntBond) ([Bond] -> [Bond]) -> [Bond] -> [Bond]
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bndNames
      bndNames_ :: [[Char]]
bndNames_ = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsList
    in 
      do 
        Rate
totalDue <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Int -> [[Char]] -> DealStats
CurrentDueBondIntAt Int
idx [[Char]]
bndNames_)
        Balance
actualPaidOut <- TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
totalDue) Maybe Limit
mLimit
        let ([Bond]
paidBonds, Balance
_) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
paySequentially Date
d Balance
actualPaidOut (Bond -> Int -> Balance
forall lb. Liable lb => lb -> Int -> Balance
`L.getTotalDueIntAt` Int
idx) (Date -> Int -> Balance -> Bond -> Bond
L.payIntByIndex Date
d Int
idx) [] [Bond]
bndsList
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {accounts = Map.adjust (A.draw actualPaidOut d (PayInt bndNames_)) an accMap
                    , bonds =  Map.fromList (zip bndNames_ paidBonds) <> bndMap}


performAction Date
d t :: TestDeal a
t@TestDeal{fees :: forall a. TestDeal a -> Map [Char] Fee
fees=Map [Char] Fee
feeMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayFeeResidual Maybe Limit
mlimit [Char]
an [Char]
feeName) =
  let
    availBal :: Balance
availBal = Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an
  in 
    do 
      Balance
paidOutAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
availBal Balance
availBal Maybe Limit
mlimit
      let accMapAfterPay :: Map [Char] Account
accMapAfterPay = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
paidOutAmt Date
d ([Char] -> TxnComment
PayFeeYield [Char]
feeName)) [Char]
an Map [Char] Account
accMap
      let feeMapAfterPay :: Map [Char] Fee
feeMapAfterPay = (Fee -> Fee) -> [Char] -> Map [Char] Fee -> Map [Char] Fee
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Balance -> Fee -> Fee
F.payResidualFee Date
d Balance
paidOutAmt) [Char]
feeName Map [Char] Fee
feeMap
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {accounts = accMapAfterPay, fees = feeMapAfterPay}

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} 
                (W.PayPrinBySeq Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport) 
  = let 
     availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
     bndsList :: [Bond]
bndsList = Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map [Char] Bond
bndMap ([Char] -> Bond) -> [[Char]] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bnds
     bndsToPay :: [Bond]
bndsToPay = (Bond -> Bool) -> [Bond] -> [Bond]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Bond -> Bool) -> Bond -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bond -> Bool
forall lb. Liable lb => lb -> Bool
L.isPaidOff) [Bond]
bndsList
     bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
   in
     do
       [Bond]
bndsWithDue <- [Either [Char] Bond] -> Either [Char] [Bond]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Bond] -> Either [Char] [Bond])
-> [Either [Char] Bond] -> Either [Char] [Bond]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDuePrin TestDeal a
t Date
d (Bond -> Either [Char] Bond) -> [Bond] -> [Either [Char] Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
       let bndsDueAmts :: [Balance]
bndsDueAmts = Bond -> Balance
L.bndDuePrin (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsWithDue
       let totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
bndsDueAmts -- `debug` ("Date"++show d++" due amt"++show bndsDueAmts)
       let actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
       Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut -- `debug` ("Date"++show d++" paid out amt"++show actualPaidOut)
       let ([Bond]
bondsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
paySequentially Date
d Balance
paidOutAmt Bond -> Balance
L.bndDuePrin (Date -> Balance -> Bond -> Bond
L.payPrin Date
d) [] [Bond]
bndsWithDue
       let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
     
       let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayPrin bndsToPayNames)) an accMap
                            ,bonds = Map.fromList (zip bndsToPayNames bondsPaid) <> bndMap}

       let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
       TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} 
                (W.PayPrinGroup Maybe Limit
mLimit [Char]
an [Char]
bndGrpName PayOrderBy
by Maybe ExtraSupport
mSupport) 
  = let 
     availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
     bg :: Bond
bg@(L.BondGroup Map [Char] Bond
bndsMap Maybe BondType
pt) = Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bndGrpName
     bndsToPay :: Map [Char] Bond
bndsToPay = (Bond -> Bool) -> Map [Char] Bond -> Map [Char] Bond
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (Bond -> Bool) -> Bond -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bond -> Bool
forall lb. Liable lb => lb -> Bool
L.isPaidOff) Map [Char] Bond
bndsMap
     bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map [Char] Bond
bndsToPay
   in
     do
       Map [Char] Bond
bndsWithDueMap <- Map [Char] (Either [Char] Bond) -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map [Char] (f a) -> f (Map [Char] a)
sequenceA (Map [Char] (Either [Char] Bond)
 -> Either [Char] (Map [Char] Bond))
-> Map [Char] (Either [Char] Bond)
-> Either [Char] (Map [Char] Bond)
forall a b. (a -> b) -> a -> b
$ (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Map [Char] (Either [Char] Bond)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDuePrin TestDeal a
t Date
d) Map [Char] Bond
bndsToPay
       Rate
bgGap <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> [Char] -> DealStats
BondBalanceGapAt Date
d [Char]
bndGrpName)
       let bndsDueAmtsMap :: Map [Char] (Bond, Balance)
bndsDueAmtsMap = (Bond -> (Bond, Balance))
-> Map [Char] Bond -> Map [Char] (Bond, Balance)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Bond
x -> (Bond
x, Bond -> Balance
L.bndDuePrin Bond
x)) Map [Char] Bond
bndsWithDueMap
       let actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
bgGap) Maybe Limit
mLimit
       Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut

       let payOutPlan :: [(Bond, Balance)]
payOutPlan = PayOrderBy -> Balance -> [(Bond, Balance)] -> [(Bond, Balance)]
allocAmtToBonds PayOrderBy
by Balance
paidOutAmt (Map [Char] (Bond, Balance) -> [(Bond, Balance)]
forall k a. Map k a -> [a]
Map.elems Map [Char] (Bond, Balance)
bndsDueAmtsMap) -- `debug` (">date"++ show payAmount)
       let payOutPlanWithBondName :: [([Char], Balance)]
payOutPlanWithBondName = [ (Bond -> [Char]
L.bndName Bond
bnd,Balance
amt) | (Bond
bnd,Balance
amt) <- [(Bond, Balance)]
payOutPlan] -- `debug` (">date"++show d++"payOutPlan"++ show payOutPlan)

       let bndMapAfterPay :: Map [Char] Bond
bndMapAfterPay = (([Char], Balance) -> Map [Char] Bond -> Map [Char] Bond)
-> Map [Char] Bond -> [([Char], Balance)] -> Map [Char] Bond
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
                              (\([Char]
bndName, Balance
_amt) Map [Char] Bond
acc -> (Bond -> Bond) -> [Char] -> Map [Char] Bond -> Map [Char] Bond
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Balance -> Bond -> Bond
L.payPrin Date
d Balance
_amt) [Char]
bndName Map [Char] Bond
acc)
                              Map [Char] Bond
bndsMap
                              [([Char], Balance)]
payOutPlanWithBondName -- `debug` (">date"++show d++"payoutPlan"++ show payOutPlanWithBondName)
       let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
     
       let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayGroupPrin bndsToPayNames)) an accMap
                            ,bonds = Map.insert bndGrpName (L.BondGroup bndMapAfterPay pt) bndMap}

       let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
       TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc


-- ^ accure interest and payout interest to a bond group with sequence input "by"
performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap} (W.AccrueAndPayIntGroup Maybe Limit
mLimit [Char]
an [Char]
bndName PayOrderBy
by Maybe ExtraSupport
mSupport)
  = do 
      TestDeal a
dAfterAcc <- Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
t ([[Char]] -> Action
W.AccrueIntGroup [[Char]
bndName])-- `debug` ("Acc due int grp"++ show (getDueInt (bndMap Map.! bndName)))
      Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
dAfterAcc (Maybe Limit
-> [Char] -> [Char] -> PayOrderBy -> Maybe ExtraSupport -> Action
W.PayIntGroup Maybe Limit
mLimit [Char]
an [Char]
bndName PayOrderBy
by Maybe ExtraSupport
mSupport)

-- ^ accrue interest for a group of bonds
performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap} (W.AccrueIntGroup [[Char]]
bndNames)
  = do 
      let bondGrp :: Map [Char] Bond
bondGrp = ([Char] -> Bond -> Bool) -> Map [Char] Bond -> Map [Char] Bond
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\[Char]
k Bond
_ -> [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member [Char]
k ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
S.fromList [[Char]]
bndNames)) Map [Char] Bond
bndMap
      Map [Char] Bond
bondGrpAccrued <- (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d) Map [Char] Bond
bondGrp
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t {bonds = bondGrpAccrued <> bndMap}

-- ^ pay interest for a group of bonds with sequence input "by"
performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayIntGroup Maybe Limit
mLimit [Char]
an [Char]
bndGrpName PayOrderBy
by Maybe ExtraSupport
mSupport)
  = let 
     availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
     L.BondGroup Map [Char] Bond
bndsMap Maybe BondType
pt = Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bndGrpName
     bndsToPay :: Map [Char] Bond
bndsToPay = (Bond -> Bool) -> Map [Char] Bond -> Map [Char] Bond
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (Bond -> Bool) -> Bond -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bond -> Bool
forall lb. Liable lb => lb -> Bool
L.isPaidOff) Map [Char] Bond
bndsMap
     bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map [Char] Bond
bndsToPay
   in
     do
       Map [Char] Bond
bndsWithDueMap <- (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d) Map [Char] Bond
bndsToPay
       let bndsDueAmtsMap :: Map [Char] (Bond, Balance)
bndsDueAmtsMap = (Bond -> (Bond, Balance))
-> Map [Char] Bond -> Map [Char] (Bond, Balance)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Bond
x -> (Bond
x, Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt Bond
x)) Map [Char] Bond
bndsWithDueMap
       let totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ (Bond, Balance) -> Balance
forall a b. (a, b) -> b
snd ((Bond, Balance) -> Balance) -> [(Bond, Balance)] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] (Bond, Balance) -> [(Bond, Balance)]
forall k a. Map k a -> [a]
Map.elems Map [Char] (Bond, Balance)
bndsDueAmtsMap -- `debug` (">date"++show d++" due amt"++show bndsDueAmtsMap)
       let actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
       Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut

       let payOutPlan :: [(Bond, Balance)]
payOutPlan = PayOrderBy -> Balance -> [(Bond, Balance)] -> [(Bond, Balance)]
allocAmtToBonds PayOrderBy
by Balance
paidOutAmt (Map [Char] (Bond, Balance) -> [(Bond, Balance)]
forall k a. Map k a -> [a]
Map.elems Map [Char] (Bond, Balance)
bndsDueAmtsMap) -- `debug` (">date"++ show payAmount)
       let payOutPlanWithBondName :: [([Char], Balance)]
payOutPlanWithBondName = [ (Bond -> [Char]
L.bndName Bond
bnd,Balance
amt) | (Bond
bnd,Balance
amt) <- [(Bond, Balance)]
payOutPlan] -- `debug` (">date"++show d++"payOutPlan"++ show payOutPlan)

       let bndMapAfterPay :: Map [Char] Bond
bndMapAfterPay = (([Char], Balance) -> Map [Char] Bond -> Map [Char] Bond)
-> Map [Char] Bond -> [([Char], Balance)] -> Map [Char] Bond
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
                              (\([Char]
bndName, Balance
_amt) Map [Char] Bond
acc -> (Bond -> Bond) -> [Char] -> Map [Char] Bond -> Map [Char] Bond
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Balance -> Bond -> Bond
L.payInt Date
d Balance
_amt) [Char]
bndName Map [Char] Bond
acc)
                              Map [Char] Bond
bndsMap
                              [([Char], Balance)]
payOutPlanWithBondName -- `debug` (">date"++show d++"payoutPlan"++ show payOutPlanWithBondName)
       let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
     
       let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayGroupInt bndsToPayNames)) an accMap
                            ,bonds = Map.insert bndGrpName (L.BondGroup bndMapAfterPay pt) bndMap}

       let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
       TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc


performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayPrinWithDue [Char]
an [[Char]]
bnds Maybe ExtraSupport
Nothing) 
  = TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {accounts = accMapAfterPay, bonds = bndMapUpdated}
    where
      acc :: Account
acc = Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an
      availBal :: Balance
availBal = Account -> Balance
A.accBalance Account
acc
      bndsToPay :: [Bond]
bndsToPay = TestDeal a -> [[Char]] -> [Bond]
forall a. SPV a => a -> [[Char]] -> [Bond]
getActiveBonds TestDeal a
t [[Char]]
bnds
      bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
      bndsDueAmts :: [Balance]
bndsDueAmts = Bond -> Balance
L.bndDuePrin (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
      actualPaidOut :: Balance
actualPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availBal (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
bndsDueAmts

      ([Bond]
bndsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
actualPaidOut Bond -> Balance
L.bndDuePrin (Date -> Balance -> Bond -> Bond
L.payPrin Date
d) [Bond]
bndsToPay
      
      bndMapUpdated :: Map [Char] Bond
bndMapUpdated = ([([Char], Bond)] -> Map [Char] Bond
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], Bond)] -> Map [Char] Bond)
-> [([Char], Bond)] -> Map [Char] Bond
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Bond] -> [([Char], Bond)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
bndsToPayNames [Bond]
bndsPaid) Map [Char] Bond -> Map [Char] Bond -> Map [Char] Bond
forall a. Semigroup a => a -> a -> a
<> Map [Char] Bond
bndMap
      accMapAfterPay :: Map [Char] Account
accMapAfterPay = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
actualPaidOut Date
d ([[Char]] -> TxnComment
PayPrin [[Char]]
bnds)) [Char]
an Map [Char] Account
accMap


performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap} (W.PayPrin Maybe Limit
mLimit [Char]
an [[Char]]
bnds Maybe ExtraSupport
mSupport)
  = let 
     availAccBal :: Balance
availAccBal = Account -> Balance
A.accBalance (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an)
     bndsToPay :: [Bond]
bndsToPay = TestDeal a -> [[Char]] -> [Bond]
forall a. SPV a => a -> [[Char]] -> [Bond]
getActiveBonds TestDeal a
t [[Char]]
bnds
  in
     do
       [Bond]
bndsWithDue <- [Either [Char] Bond] -> Either [Char] [Bond]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Bond] -> Either [Char] [Bond])
-> [Either [Char] Bond] -> Either [Char] [Bond]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDuePrin TestDeal a
t Date
d (Bond -> Either [Char] Bond) -> [Bond] -> [Either [Char] Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
       let bndsDueAmts :: [Balance]
bndsDueAmts = Bond -> Balance
L.bndDuePrin (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsWithDue
       let bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsWithDue
       let totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
bndsDueAmts
       let actualPaidOut :: Either [Char] Balance
actualPaidOut = TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Account
-> Maybe ExtraSupport
-> Balance
-> Maybe Limit
-> Either [Char] Balance
calcAvailAfterLimit TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an) Maybe ExtraSupport
mSupport Balance
totalDue Maybe Limit
mLimit
       Balance
paidOutAmt <- Either [Char] Balance
actualPaidOut
       let ([Bond]
bondsPaid, Balance
remainAmt) = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [Bond]
-> ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
paidOutAmt Bond -> Balance
L.bndDuePrin (Date -> Balance -> Bond -> Bond
L.payPrin Date
d) [Bond]
bndsWithDue
       let accPaidOut :: Balance
accPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availAccBal Balance
paidOutAmt
     
       let dealAfterAcc :: TestDeal a
dealAfterAcc = TestDeal a
t {accounts = Map.adjust (A.draw accPaidOut d (PayPrin bndsToPayNames)) an accMap
                            ,bonds = Map.fromList (zip bndsToPayNames bondsPaid) <> bndMap}

       let supportPaidOut :: Balance
supportPaidOut = Balance
paidOutAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
accPaidOut
       TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
forall a.
Asset a =>
Date -> Maybe ExtraSupport -> Balance -> TestDeal a -> TestDeal a
updateSupport Date
d Maybe ExtraSupport
mSupport Balance
supportPaidOut TestDeal a
dealAfterAcc

-- ^ pay principal without any limit
performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap, bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap} (W.PayPrinResidual [Char]
an [[Char]]
bnds) = 
  TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {accounts = accMapAfterPay, bonds = bndMapUpdated} -- `debug` ("Bond Prin Pay Result"++show(bndMapUpdated))
  where
    acc :: Account
acc = Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an

    bndsToPay :: [Bond]
bndsToPay = TestDeal a -> [[Char]] -> [Bond]
forall a. SPV a => a -> [[Char]] -> [Bond]
getActiveBonds TestDeal a
t [[Char]]
bnds
    bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
    availBal :: Balance
availBal = Account -> Balance
A.accBalance Account
acc
    bndsDueAmts :: [Balance]
bndsDueAmts = (Bond -> Balance) -> [Bond] -> [Balance]
forall a b. (a -> b) -> [a] -> [b]
map Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getCurBalance [Bond]
bndsToPay

    actualPaidOut :: Balance
actualPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
availBal (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
bndsDueAmts -- `debug` ("bonds totoal due ->"++show(bndsDueAmts))
    bndsAmountToBePaid :: [(Bond, Balance)]
bndsAmountToBePaid = [Bond] -> [Balance] -> [(Bond, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bond]
bndsToPay ([Balance] -> Balance -> [Balance]
prorataFactors [Balance]
bndsDueAmts Balance
actualPaidOut)
    bndsPaid :: [Bond]
bndsPaid = ((Bond, Balance) -> Bond) -> [(Bond, Balance)] -> [Bond]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bond
l,Balance
amt) -> Date -> Balance -> Bond -> Bond
L.payPrin Date
d Balance
amt Bond
l) [(Bond, Balance)]
bndsAmountToBePaid  -- `debug` ("pay bonds "++show bnds ++"pay prin->>>To"++show(prorataFactors bndsDueAmts availBal))

    bndMapUpdated :: Map [Char] Bond
bndMapUpdated =  ([([Char], Bond)] -> Map [Char] Bond
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], Bond)] -> Map [Char] Bond)
-> [([Char], Bond)] -> Map [Char] Bond
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Bond] -> [([Char], Bond)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
bndsToPayNames [Bond]
bndsPaid) Map [Char] Bond -> Map [Char] Bond -> Map [Char] Bond
forall a. Semigroup a => a -> a -> a
<> Map [Char] Bond
bndMap
    accMapAfterPay :: Map [Char] Account
accMapAfterPay = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
actualPaidOut Date
d ([[Char]] -> TxnComment
PayPrin [[Char]]
bnds)) [Char]
an Map [Char] Account
accMap

performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accMap, bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap} (W.FundWith Maybe Limit
mlimit [Char]
an [Char]
bnd) = 
  do
    Rate
fundAmt_ <- case Maybe Limit
mlimit of 
                  Just (DS DealStats
ds) -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                  Just (DueCapAmt Balance
amt) -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate) -> Rate -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ Balance -> Rate
forall a. Real a => a -> Rate
toRational Balance
amt
                  Maybe Limit
_ -> [Char] -> Either [Char] Rate
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Rate) -> [Char] -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Not valid limit for funding with bond"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
bnd
    let fundAmt :: Balance
fundAmt = Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
fundAmt_
    let accMapAfterFund :: Map [Char] Account
accMapAfterFund = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
fundAmt Date
d ([Char] -> Balance -> TxnComment
FundWith [Char]
bnd Balance
fundAmt)) [Char]
an Map [Char] Account
accMap
    let bndFunded :: Bond
bndFunded = Date -> Balance -> Bond -> Bond
L.fundWith Date
d Balance
fundAmt (Bond -> Bond) -> Bond -> Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bnd
    TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {accounts = accMapAfterFund, bonds= Map.fromList [(bnd,bndFunded)] <> bndMap } 

-- ^ write off bonds and book 
performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds = Map [Char] Bond
bndMap, ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers = Just Map [Char] Ledger
ledgerM } 
              (W.WriteOffAndBook Maybe Limit
mLimit [Char]
bnd (BookDirection
dr,[Char]
lName))
  = let 
      bndToWriteOff :: Bond
bndToWriteOff = Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bnd
      bndBal :: Balance
bndBal = Bond -> Balance
L.bndBalance Bond
bndToWriteOff
    in
      do 
        Balance
writeAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
bndBal Balance
bndBal Maybe Limit
mLimit
        let newLedgerM :: Map [Char] Ledger
newLedgerM = (Ledger -> Ledger)
-> [Char] -> Map [Char] Ledger -> Map [Char] Ledger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (BookDirection
-> Balance -> Date -> Maybe TxnComment -> Ledger -> Ledger
LD.entryLogByDr BookDirection
dr Balance
writeAmt Date
d (TxnComment -> Maybe TxnComment
forall a. a -> Maybe a
Just ([Char] -> Balance -> TxnComment
WriteOff [Char]
bnd Balance
writeAmt))) [Char]
lName Map [Char] Ledger
ledgerM
        Bond
bndWritedOff <- Date -> Balance -> Bond -> Either [Char] Bond
L.writeOff Date
d Balance
writeAmt Bond
bndToWriteOff
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {bonds = Map.fromList [(bnd,bndWritedOff)] <> bndMap, ledgers = Just newLedgerM}

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap} (W.WriteOff Maybe Limit
mlimit [Char]
bnd)
  = do 
      Rate
writeAmt <- case Maybe Limit
mlimit of
                    Just (DS DealStats
ds) -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                    Just (DueCapAmt Balance
amt) -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate) -> Rate -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ Balance -> Rate
forall a. Real a => a -> Rate
toRational Balance
amt
                    Maybe Limit
Nothing -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate) -> Rate -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ Balance -> Rate
forall a. Real a => a -> Rate
toRational (Balance -> Rate) -> (Bond -> Balance) -> Bond -> Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bond -> Balance
L.bndBalance (Bond -> Rate) -> Bond -> Rate
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bnd
                    Maybe Limit
x -> [Char] -> Either [Char] Rate
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Rate) -> [Char] -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"not supported type to determine the amount to write off"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Limit -> [Char]
forall a. Show a => a -> [Char]
show Maybe Limit
x

      let writeAmtCapped :: Balance
writeAmtCapped = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
writeAmt) (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ Bond -> Balance
L.bndBalance (Bond -> Balance) -> Bond -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bnd
      Bond
bndWritedOff <- Date -> Balance -> Bond -> Either [Char] Bond
L.writeOff Date
d Balance
writeAmtCapped (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Bond
forall a b. (a -> b) -> a -> b
$ Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
bnd
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {bonds = Map.fromList [(bnd,bndWritedOff)] <> bndMap}

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap, ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers = Just Map [Char] Ledger
ledgerM} 
              (W.WriteOffBySeqAndBook Maybe Limit
mLimit [[Char]]
bnds (BookDirection
dr,[Char]
lName))
  = do
      [Bond]
bndsToWriteOff <- ([Char] -> Either [Char] Bond) -> [[Char]] -> Either [Char] [Bond]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d (Bond -> Either [Char] Bond)
-> ([Char] -> Bond) -> [Char] -> Either [Char] Bond
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.!)) [[Char]]
bnds
      let totalBondBal :: Balance
totalBondBal = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ Bond -> Balance
L.bndBalance (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToWriteOff
      -- total amount to be write off
      Balance
writeAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
totalBondBal Balance
totalBondBal Maybe Limit
mLimit
      ([Bond]
bndWrited, Balance
_) <- Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Either [Char] Bond)
-> Either [Char] [Bond]
-> [Bond]
-> Either [Char] ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> Either [Char] a)
-> Either [Char] [a]
-> [a]
-> Either [Char] ([a], Balance)
paySeqM Date
d Balance
writeAmt Bond -> Balance
L.bndBalance (Date -> Balance -> Bond -> Either [Char] Bond
L.writeOff Date
d) ([Bond] -> Either [Char] [Bond]
forall a b. b -> Either a b
Right []) [Bond]
bndsToWriteOff 
      let bndMapUpdated :: Map [Char] Bond
bndMapUpdated = (Bond -> [Char]) -> [Bond] -> Map [Char] Bond
forall a. (a -> [Char]) -> [a] -> Map [Char] a
lstToMapByFn Bond -> [Char]
L.bndName [Bond]
bndWrited
      let newLedgerM :: Map [Char] Ledger
newLedgerM = (Ledger -> Ledger)
-> [Char] -> Map [Char] Ledger -> Map [Char] Ledger
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (BookDirection
-> Balance -> Date -> Maybe TxnComment -> Ledger -> Ledger
LD.entryLogByDr BookDirection
dr Balance
writeAmt Date
d Maybe TxnComment
forall a. Maybe a
Nothing) [Char]
lName Map [Char] Ledger
ledgerM
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t {bonds = bndMapUpdated <> bndMap, ledgers = Just newLedgerM}


performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap } (W.WriteOffBySeq Maybe Limit
mLimit [[Char]]
bnds)
  = do 
      [Bond]
bondsToWriteOff <- ([Char] -> Either [Char] Bond) -> [[Char]] -> Either [Char] [Bond]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d (Bond -> Either [Char] Bond)
-> ([Char] -> Bond) -> [Char] -> Either [Char] Bond
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.!)) [[Char]]
bnds
      let totalBondBal :: Balance
totalBondBal = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ Bond -> Balance
L.bndBalance (Bond -> Balance) -> [Bond] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bondsToWriteOff
      Balance
writeAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
totalBondBal Balance
totalBondBal Maybe Limit
mLimit
      ([Bond]
bndWrited, Balance
_) <- Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Either [Char] Bond)
-> Either [Char] [Bond]
-> [Bond]
-> Either [Char] ([Bond], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> Either [Char] a)
-> Either [Char] [a]
-> [a]
-> Either [Char] ([a], Balance)
paySeqM Date
d Balance
writeAmt Bond -> Balance
L.bndBalance (Date -> Balance -> Bond -> Either [Char] Bond
L.writeOff Date
d) ([Bond] -> Either [Char] [Bond]
forall a b. b -> Either a b
Right []) [Bond]
bondsToWriteOff 
      let bndMapUpdated :: Map [Char] Bond
bndMapUpdated = (Bond -> [Char]) -> [Bond] -> Map [Char] Bond
forall a. (a -> [Char]) -> [a] -> Map [Char] a
lstToMapByFn Bond -> [Char]
L.bndName [Bond]
bndWrited
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t {bonds = bndMapUpdated <> bndMap }

performAction Date
d t :: TestDeal a
t@TestDeal{fees :: forall a. TestDeal a -> Map [Char] Fee
fees=Map [Char] Fee
feeMap} (W.CalcFee [[Char]]
fns) 
  = do
      Map [Char] Fee
newFeeMap <- (Fee -> Either [Char] Fee)
-> Map [Char] Fee -> Either [Char] (Map [Char] Fee)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a -> Date -> Fee -> Either [Char] Fee
forall a. Asset a => TestDeal a -> Date -> Fee -> Either [Char] Fee
calcDueFee TestDeal a
t Date
d) (Map [Char] Fee -> Either [Char] (Map [Char] Fee))
-> Map [Char] Fee -> Either [Char] (Map [Char] Fee)
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Maybe [[Char]] -> Map [Char] Fee
forall a. SPV a => a -> Maybe [[Char]] -> Map [Char] Fee
getFeeByName TestDeal a
t ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just [[Char]]
fns)
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t {fees = newFeeMap <> feeMap }

-- performAction d t@TestDeal{bonds=bndMap} (W.CalcBondIntBy bn dsBal dsRate) 
--   = let 
--       mBnd = case getBondByName t bn of
--                Just b -> Right b
--                Nothing -> Left $ "Cant find bond in deal"++ show bn
--     in 
--       do 
--         bal <- queryCompound t d (patchDateToStats d dsBal)
--         rate <- queryCompound t d (patchDateToStats d dsRate)
--         bnd <- mBnd
--         let dc = DC_ACT_365F
--         let dueInt = L.calcDueInt bnd bal rate dc
--         newBondMap <- mapM (calcDueInt t d mBalDs mRateDs) $ getBondsByName t (Just bns)
--       
--         return t {bonds = newBondMap <> bndMap}

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap} (W.CalcBondInt [[Char]]
bns) 
  = do 
      Map [Char] Bond
newBondMap <- (Bond -> Either [Char] Bond)
-> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map [Char] a -> m (Map [Char] b)
mapM (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDueInt TestDeal a
t Date
d) (Map [Char] Bond -> Either [Char] (Map [Char] Bond))
-> Map [Char] Bond -> Either [Char] (Map [Char] Bond)
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Maybe [[Char]] -> Map [Char] Bond
forall a. SPV a => a -> Maybe [[Char]] -> Map [Char] Bond
getBondsByName TestDeal a
t ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just [[Char]]
bns)
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t {bonds = newBondMap <> bndMap}

-- ^ set due prin mannually
performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap} (W.CalcBondPrin2 Maybe Limit
mLimit [[Char]]
bnds) 
  = let 
      bndsToPay :: [Bond]
bndsToPay = (Bond -> Bool) -> [Bond] -> [Bond]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Bond -> Bool) -> Bond -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bond -> Bool
forall lb. Liable lb => lb -> Bool
L.isPaidOff) ([Bond] -> [Bond]) -> [Bond] -> [Bond]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bond) -> [[Char]] -> [Bond]
forall a b. (a -> b) -> [a] -> [b]
map (Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.!) [[Char]]
bnds
      bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
    in 
      do 
        [Balance]
bndsDueAmts <- [Either [Char] Balance] -> Either [Char] [Balance]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Balance] -> Either [Char] [Balance])
-> [Either [Char] Balance] -> Either [Char] [Balance]
forall a b. (a -> b) -> a -> b
$ (Bond -> Balance
L.bndDuePrin (Bond -> Balance) -> Either [Char] Bond -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either [Char] Bond -> Either [Char] Balance)
-> (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDuePrin TestDeal a
t Date
d) (Bond -> Either [Char] Balance)
-> [Bond] -> [Either [Char] Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
        let totalDue :: Balance
totalDue = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
bndsDueAmts
        Balance
bookCap <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
totalDue Balance
totalDue Maybe Limit
mLimit
        let bndsAmountToBook :: [([Char], Balance)]
bndsAmountToBook = [[Char]] -> [Balance] -> [([Char], Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
bndsToPayNames ([Balance] -> [([Char], Balance)])
-> [Balance] -> [([Char], Balance)]
forall a b. (a -> b) -> a -> b
$ [Balance] -> Balance -> [Balance]
prorataFactors [Balance]
bndsDueAmts Balance
bookCap
        let newBndMap :: Map [Char] Bond
newBndMap = (([Char], Balance) -> Map [Char] Bond -> Map [Char] Bond)
-> Map [Char] Bond -> [([Char], Balance)] -> Map [Char] Bond
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
                          (\([Char]
bn,Balance
amt) Map [Char] Bond
acc -> (Bond -> Bond) -> [Char] -> Map [Char] Bond -> Map [Char] Bond
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\Bond
b -> Bond
b {L.bndDuePrin = amt})  [Char]
bn Map [Char] Bond
acc) 
                          Map [Char] Bond
bndMap 
                          [([Char], Balance)]
bndsAmountToBook -- `debug` ("Calc Bond Prin"++ show bndsAmountToBePaid)

        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {bonds = newBndMap} -- `debug` ("New map after calc due"++ show (Map.mapWithKey (\k v -> (k, L.bndDuePrin v)) newBndMap))

performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accMap} (W.CalcBondPrin Maybe Limit
mLimit [Char]
accName [[Char]]
bnds Maybe ExtraSupport
mSupport) 
  = let 
      accBal :: Balance
accBal = Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
accName
      bndsToPay :: [Bond]
bndsToPay = (Bond -> Bool) -> [Bond] -> [Bond]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Bond -> Bool) -> Bond -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bond -> Bool
forall lb. Liable lb => lb -> Bool
L.isPaidOff) ([Bond] -> [Bond]) -> [Bond] -> [Bond]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bond) -> [[Char]] -> [Bond]
forall a b. (a -> b) -> [a] -> [b]
map (Map [Char] Bond
bndMap Map [Char] Bond -> [Char] -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.!) [[Char]]
bnds
      bndsToPayNames :: [[Char]]
bndsToPayNames = Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
    in
      do 
        [Balance]
bndsDueAmts <- [Either [Char] Balance] -> Either [Char] [Balance]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] Balance] -> Either [Char] [Balance])
-> [Either [Char] Balance] -> Either [Char] [Balance]
forall a b. (a -> b) -> a -> b
$ (Bond -> Balance
L.bndDuePrin (Bond -> Balance) -> Either [Char] Bond -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either [Char] Bond -> Either [Char] Balance)
-> (Bond -> Either [Char] Bond) -> Bond -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestDeal a -> Date -> Bond -> Either [Char] Bond
forall a.
Asset a =>
TestDeal a -> Date -> Bond -> Either [Char] Bond
calcDuePrin TestDeal a
t Date
d) (Bond -> Either [Char] Balance)
-> [Bond] -> [Either [Char] Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bndsToPay
        Balance
availBal <- TestDeal a
-> Date -> Account -> Maybe ExtraSupport -> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date -> Account -> Maybe ExtraSupport -> Either [Char] Balance
calcAvailFund TestDeal a
t Date
d (Map [Char] Account
accMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
accName) Maybe ExtraSupport
mSupport
        Balance
limitCap <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
availBal ([Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
bndsDueAmts) Maybe Limit
mLimit
        let payAmount :: Balance
payAmount = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
limitCap Balance
availBal 
        let bndsAmountToBePaid :: [([Char], Balance)]
bndsAmountToBePaid = [[Char]] -> [Balance] -> [([Char], Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
bndsToPayNames ([Balance] -> [([Char], Balance)])
-> [Balance] -> [([Char], Balance)]
forall a b. (a -> b) -> a -> b
$ [Balance] -> Balance -> [Balance]
prorataFactors [Balance]
bndsDueAmts Balance
payAmount  -- (bond, amt-allocated)
        let newBndMap :: Map [Char] Bond
newBndMap = (([Char], Balance) -> Map [Char] Bond -> Map [Char] Bond)
-> Map [Char] Bond -> [([Char], Balance)] -> Map [Char] Bond
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
                          (\([Char]
bn,Balance
amt) Map [Char] Bond
acc -> (Bond -> Bond) -> [Char] -> Map [Char] Bond -> Map [Char] Bond
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\Bond
b -> Bond
b {L.bndDuePrin = amt})  [Char]
bn Map [Char] Bond
acc) 
                          Map [Char] Bond
bndMap 
                          [([Char], Balance)]
bndsAmountToBePaid -- `debug` ("Calc Bond Prin"++ show bndsAmountToBePaid)
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {bonds = newBndMap}

      
-- ^ draw cash and deposit to account
performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accs, liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Just Map [Char] LiqFacility
_liqProvider} (W.LiqSupport Maybe Limit
mLimit [Char]
pName LiqDrawType
CE.LiqToAcc [[Char]]
ans)
  | [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
ans Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 
      = let 
          liq :: LiqFacility
liq = Map [Char] LiqFacility
_liqProvider Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
pName 
          [[Char]
an] = [[Char]]
ans
        in 
          do 
            Rate
transferAmt <- case (LiqFacility -> Maybe Balance
CE.liqCredit LiqFacility
liq, Maybe Limit
mLimit) of 
                             (Maybe Balance
Nothing, Maybe Limit
Nothing) -> [Char] -> Either [Char] Rate
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Rate) -> [Char] -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Can't deposit unlimit cash to an account in LiqSupport(Account):"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
pName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
an
                             (Just Balance
av, Maybe Limit
Nothing) -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Rate -> Either [Char] Rate)
-> (Balance -> Rate) -> Balance -> Either [Char] Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Rate
forall a. Real a => a -> Rate
toRational (Balance -> Either [Char] Rate) -> Balance -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ Balance
av
                             (Maybe Balance
Nothing, Just (DS DealStats
ds)) -> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds) -- `debug` ("hit with ds"++ show ds)
                             (Just Balance
av, Just (DS DealStats
ds)) -> (Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
min (Balance -> Rate
forall a. Real a => a -> Rate
toRational Balance
av)) (Rate -> Rate) -> Either [Char] Rate -> Either [Char] Rate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds) 
                             (Maybe Balance
_ , Just Limit
_x) -> [Char] -> Either [Char] Rate
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Rate) -> [Char] -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Not support limit in LiqSupport(Account)"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Limit -> [Char]
forall a. Show a => a -> [Char]
show Limit
_x 
            let dAmt :: Balance
dAmt = Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
transferAmt
            TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t { accounts = Map.adjust (A.deposit dAmt d (LiquidationSupport pName)) an accs
                     , liqProvider = Just $ Map.adjust (CE.draw dAmt d) pName _liqProvider }
  | Bool
otherwise = [Char] -> Either [Char] (TestDeal a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (TestDeal a))
-> [Char] -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"There should only one account for LiqToAcc of LiqSupport"


-- TODO : add pay fee by sequence
performAction Date
d t :: TestDeal a
t@TestDeal{fees :: forall a. TestDeal a -> Map [Char] Fee
fees=Map [Char] Fee
feeMap,liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Just Map [Char] LiqFacility
_liqProvider} (W.LiqSupport Maybe Limit
mLimit [Char]
pName LiqDrawType
CE.LiqToFee [[Char]]
fns)
  = let 
      liq :: LiqFacility
liq = Map [Char] LiqFacility
_liqProvider Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
pName 
    in 
      do 
        Rate
totalDueFee <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d ([[Char]] -> DealStats
CurrentDueFee [[Char]]
fns)
        Balance
supportAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
totalDueFee) (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
totalDueFee) Maybe Limit
mLimit

        let transferAmt :: Balance
transferAmt = case LiqFacility -> Maybe Balance
CE.liqCredit LiqFacility
liq of 
                            Maybe Balance
Nothing -> Balance
supportAmt
                            (Just Balance
v) -> Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
supportAmt Balance
v

        let newFeeMap :: Map [Char] Fee
newFeeMap = Date
-> Balance
-> (Fee -> Balance)
-> (Balance -> Fee -> Fee)
-> [[Char]]
-> HowToPay
-> Map [Char] Fee
-> Map [Char] Fee
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [[Char]]
-> HowToPay
-> Map [Char] a
-> Map [Char] a
payInMap Date
d Balance
transferAmt Fee -> Balance
F.feeDue (Date -> Balance -> Fee -> Fee
F.payFee Date
d) [[Char]]
fns HowToPay
ByProRata Map [Char] Fee
feeMap
        let newLiqMap :: Map [Char] LiqFacility
newLiqMap = (LiqFacility -> LiqFacility)
-> [Char] -> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> LiqFacility -> LiqFacility
CE.draw Balance
transferAmt Date
d) [Char]
pName Map [Char] LiqFacility
_liqProvider 
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t { fees = newFeeMap, liqProvider = Just newLiqMap }

-- TODO : add pay int by sequence
-- TODO : may not work for bond group
performAction Date
d t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds=Map [Char] Bond
bndMap,liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Just Map [Char] LiqFacility
_liqProvider} 
                (W.LiqSupport Maybe Limit
mLimit [Char]
pName LiqDrawType
CE.LiqToBondInt [[Char]]
bns)
  = let 
      liq :: LiqFacility
liq = Map [Char] LiqFacility
_liqProvider Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
pName 
    in 
      do 
        Rate
totalDueInt <- TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d ([[Char]] -> DealStats
CurrentDueBondInt [[Char]]
bns)
        Balance
supportAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
totalDueInt) (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
totalDueInt) Maybe Limit
mLimit

        let transferAmt :: Balance
transferAmt = case LiqFacility -> Maybe Balance
CE.liqCredit LiqFacility
liq of 
                            Maybe Balance
Nothing -> Balance
supportAmt
                            (Just Balance
v) -> Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
supportAmt Balance
v

        let newBondMap :: Map [Char] Bond
newBondMap = Date
-> Balance
-> (Bond -> Balance)
-> (Balance -> Bond -> Bond)
-> [[Char]]
-> HowToPay
-> Map [Char] Bond
-> Map [Char] Bond
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [[Char]]
-> HowToPay
-> Map [Char] a
-> Map [Char] a
payInMap Date
d Balance
transferAmt Bond -> Balance
forall lb. Liable lb => lb -> Balance
L.getTotalDueInt (Date -> Balance -> Bond -> Bond
L.payInt Date
d) [[Char]]
bns HowToPay
ByProRata Map [Char] Bond
bndMap
        let newLiqMap :: Map [Char] LiqFacility
newLiqMap = (LiqFacility -> LiqFacility)
-> [Char] -> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> LiqFacility -> LiqFacility
CE.draw Balance
transferAmt Date
d) [Char]
pName Map [Char] LiqFacility
_liqProvider 
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t { bonds = newBondMap, liqProvider = Just newLiqMap }


-- ^ payout due interest / due fee / oustanding balance to liq provider
performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accs,liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Just Map [Char] LiqFacility
_liqProvider} (W.LiqRepay Maybe Limit
mLimit LiqRepayType
rpt [Char]
an [Char]
pName)
  = 
    let 
      liqDueAmts :: LiqRepayType -> [Balance]
liqDueAmts LiqRepayType
CE.LiqBal = [ LiqFacility -> Balance
CE.liqBalance (LiqFacility -> Balance) -> LiqFacility -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] LiqFacility
_liqProvider Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
pName]
      liqDueAmts LiqRepayType
CE.LiqInt =  [ LiqFacility -> Balance
CE.liqDueInt (LiqFacility -> Balance) -> LiqFacility -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] LiqFacility
_liqProvider Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
pName ]
      liqDueAmts LiqRepayType
CE.LiqPremium = [ LiqFacility -> Balance
CE.liqDuePremium (LiqFacility -> Balance) -> LiqFacility -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] LiqFacility
_liqProvider Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
pName]
      liqDueAmts (CE.LiqRepayTypes [LiqRepayType]
lrts) = [[Balance]] -> [Balance]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Balance]] -> [Balance]) -> [[Balance]] -> [Balance]
forall a b. (a -> b) -> a -> b
$ LiqRepayType -> [Balance]
liqDueAmts (LiqRepayType -> [Balance]) -> [LiqRepayType] -> [[Balance]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LiqRepayType]
lrts

      overDrawnBalance :: Balance
overDrawnBalance = Balance -> (Balance -> Balance) -> Maybe Balance -> Balance
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Balance
0 Balance -> Balance
forall a. Num a => a -> a
negate (LiqFacility -> Maybe Balance
CE.liqCredit (LiqFacility -> Maybe Balance) -> LiqFacility -> Maybe Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] LiqFacility
_liqProvider Map [Char] LiqFacility -> [Char] -> LiqFacility
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
pName)
      
      dueBreakdown :: [Balance]
dueBreakdown 
        | Balance
overDrawnBalance Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0 = Balance
overDrawnBalanceBalance -> [Balance] -> [Balance]
forall a. a -> [a] -> [a]
:LiqRepayType -> [Balance]
liqDueAmts LiqRepayType
rpt
        | Bool
otherwise = LiqRepayType -> [Balance]
liqDueAmts LiqRepayType
rpt

      liqTotalDues :: Balance
liqTotalDues = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
dueBreakdown
      
      cap :: Balance
cap = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
liqTotalDues (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accs Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an
    in
      do
        Balance
transferAmt <- TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
forall a.
Asset a =>
TestDeal a
-> Date
-> Balance
-> Balance
-> Maybe Limit
-> Either [Char] Balance
applyLimit TestDeal a
t Date
d Balance
cap Balance
cap Maybe Limit
mLimit
        let paidOutsToLiq :: [Balance]
paidOutsToLiq = Balance -> [Balance] -> [Balance]
paySeqLiabilitiesAmt Balance
transferAmt [Balance]
dueBreakdown

        let rptsToPair :: [LiqRepayType]
rptsToPair = case LiqRepayType
rpt of 
                            CE.LiqRepayTypes [LiqRepayType]
lrts -> [LiqRepayType]
lrts
                            LiqRepayType
x  -> [LiqRepayType
x]

        let paidOutWithType :: [(LiqRepayType, Balance)]
paidOutWithType
              | Balance
overDrawnBalance Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0 = [LiqRepayType] -> [Balance] -> [(LiqRepayType, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip (LiqRepayType
CE.LiqODLiqRepayType -> [LiqRepayType] -> [LiqRepayType]
forall a. a -> [a] -> [a]
:[LiqRepayType]
rptsToPair) [Balance]
paidOutsToLiq 
              | Bool
otherwise = [LiqRepayType] -> [Balance] -> [(LiqRepayType, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LiqRepayType]
rptsToPair [Balance]
paidOutsToLiq -- `debug` ("rpts To pair"++ show rptsToPair)


        let newAccMap :: Map [Char] Account
newAccMap = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
transferAmt Date
d ([Char] -> TxnComment
LiquidationSupport [Char]
pName)) [Char]
an Map [Char] Account
accs -- `debug` ("repay liq amt"++ show transferAmt)
        let newLiqMap :: Map [Char] LiqFacility
newLiqMap = (Map [Char] LiqFacility
 -> (LiqRepayType, Balance) -> Map [Char] LiqFacility)
-> Map [Char] LiqFacility
-> [(LiqRepayType, Balance)]
-> Map [Char] LiqFacility
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                          (\Map [Char] LiqFacility
acc (LiqRepayType
_rpt,Balance
_amt) -> (LiqFacility -> LiqFacility)
-> [Char] -> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> LiqRepayType -> LiqFacility -> LiqFacility
CE.repay Balance
_amt Date
d LiqRepayType
_rpt ) [Char]
pName Map [Char] LiqFacility
acc)
                          Map [Char] LiqFacility
_liqProvider
                          [(LiqRepayType, Balance)]
paidOutWithType
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t { accounts = newAccMap, liqProvider = Just newLiqMap }                 --  paidOutWithType -- `debug` ("paid out"++ show paidOutWithType)

-- ^ pay yield to liq provider
performAction Date
d t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts=Map [Char] Account
accs,liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Just Map [Char] LiqFacility
_liqProvider} (W.LiqYield Maybe Limit
limit [Char]
an [Char]
pName)
  =
    let cap :: Balance
cap = Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accs Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
an in
      do 
        Rate
transferAmt <- case Maybe Limit
limit of 
                        Maybe Limit
Nothing -> Rate -> Either [Char] Rate
forall a b. b -> Either a b
Right (Balance -> Rate
forall a. Real a => a -> Rate
toRational Balance
cap)
                        Just (DS DealStats
ds) -> (Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
min (Balance -> Rate
forall a. Real a => a -> Rate
toRational Balance
cap)) (Rate -> Rate) -> Either [Char] Rate -> Either [Char] Rate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)) 
                        Maybe Limit
_ -> [Char] -> Either [Char] Rate
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Rate) -> [Char] -> Either [Char] Rate
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Not implement the limit"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Limit -> [Char]
forall a. Show a => a -> [Char]
show Maybe Limit
limit[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"For Pay Yield to liqProvider"
      
        let newAccMap :: Map [Char] Account
newAccMap = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
transferAmt) Date
d ([Char] -> TxnComment
LiquidationSupport [Char]
pName)) [Char]
an Map [Char] Account
accs
        let newLiqMap :: Map [Char] LiqFacility
newLiqMap = (LiqFacility -> LiqFacility)
-> [Char] -> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> LiqRepayType -> LiqFacility -> LiqFacility
CE.repay (Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational Rate
transferAmt) Date
d LiqRepayType
CE.LiqResidual) [Char]
pName Map [Char] LiqFacility
_liqProvider 
        TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return TestDeal a
t { accounts = newAccMap, liqProvider = Just newLiqMap }

performAction Date
d t :: TestDeal a
t@TestDeal{liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Just Map [Char] LiqFacility
_liqProvider} (W.LiqAccrue [[Char]]
liqNames)
  = TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t {liqProvider = Just updatedLiqProvider}
    where 
      updatedLiqProvider :: Map [Char] LiqFacility
updatedLiqProvider = (LiqFacility -> LiqFacility)
-> [[Char]] -> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall k a. Ord k => (a -> a) -> [k] -> Map k a -> Map k a
mapWithinMap ((TestDeal a -> Date -> LiqFacility -> LiqFacility
forall a.
Asset a =>
TestDeal a -> Date -> LiqFacility -> LiqFacility
updateLiqProvider TestDeal a
t Date
d) (LiqFacility -> LiqFacility)
-> (LiqFacility -> LiqFacility) -> LiqFacility -> LiqFacility
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Date -> LiqFacility -> LiqFacility
CE.accrueLiqProvider Date
d)) [[Char]]
liqNames Map [Char] LiqFacility
_liqProvider


performAction Date
d t :: TestDeal a
t@TestDeal{rateSwap :: forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap = Just Map [Char] RateSwap
rtSwap } (W.SwapAccrue [Char]
sName)
  = 
    do
      Balance
refBal <- case RateSwap -> RateSwapBase
HE.rsNotional (Map [Char] RateSwap
rtSwap Map [Char] RateSwap -> [Char] -> RateSwap
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
sName) of 
                  (HE.Fixed Balance
b) -> Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right Balance
b
                  (HE.Base DealStats
ds) -> Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational (Rate -> Balance) -> Either [Char] Rate -> Either [Char] Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> Date -> DealStats -> Either [Char] Rate
forall a.
Asset a =>
TestDeal a -> Date -> DealStats -> Either [Char] Rate
queryCompound TestDeal a
t Date
d (Date -> DealStats -> DealStats
patchDateToStats Date
d DealStats
ds)
                  (HE.Schedule Ts
ts) -> Balance -> Either [Char] Balance
forall a b. b -> Either a b
Right (Balance -> Either [Char] Balance)
-> (Rate -> Balance) -> Rate -> Either [Char] Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate -> Balance
forall a. Fractional a => Rate -> a
fromRational (Rate -> Either [Char] Balance) -> Rate -> Either [Char] Balance
forall a b. (a -> b) -> a -> b
$ Ts -> CutoffType -> Date -> Rate
getValByDate Ts
ts CutoffType
Inc Date
d

      let newRtSwap :: Map [Char] RateSwap
newRtSwap = (RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust 
                        (Date -> RateSwap -> RateSwap
HE.accrueIRS Date
d)
                        [Char]
sName
                        ((RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (ASetter RateSwap RateSwap Balance Balance
-> Balance -> RateSwap -> RateSwap
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter RateSwap RateSwap Balance Balance
Lens' RateSwap Balance
HE.rsRefBalLens Balance
refBal) [Char]
sName Map [Char] RateSwap
rtSwap)
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t { rateSwap = Just newRtSwap } 


performAction Date
d t :: TestDeal a
t@TestDeal{rateCap :: forall a. TestDeal a -> Maybe (Map [Char] RateCap)
rateCap = Just Map [Char] RateCap
rcM, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accsMap } (W.CollectRateCap [Char]
accName [Char]
sName)
  = TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t { rateCap = Just newRcSwap, accounts = newAccMap }
    where 
        receiveAmt :: Balance
receiveAmt = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
max Balance
0 (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ RateCap -> Balance
HE.rcNetCash (RateCap -> Balance) -> RateCap -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] RateCap
rcM Map [Char] RateCap -> [Char] -> RateCap
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
sName
        newRcSwap :: Map [Char] RateCap
newRcSwap = (RateCap -> RateCap)
-> [Char] -> Map [Char] RateCap -> Map [Char] RateCap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> RateCap -> RateCap
HE.receiveRC Date
d) [Char]
sName Map [Char] RateCap
rcM -- `debug` ("REceiv AMT"++ show receiveAmt)
        newAccMap :: Map [Char] Account
newAccMap = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
receiveAmt Date
d ([Char] -> TxnComment
SwapInSettle [Char]
sName)) [Char]
accName Map [Char] Account
accsMap


performAction Date
d t :: TestDeal a
t@TestDeal{rateSwap :: forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap = Just Map [Char] RateSwap
rtSwap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accsMap } (W.SwapReceive [Char]
accName [Char]
sName)
  = case ([Char] -> Map [Char] Account -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member [Char]
accName Map [Char] Account
accsMap, [Char] -> Map [Char] RateSwap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member [Char]
sName Map [Char] RateSwap
rtSwap) of 
      (Bool
False, Bool
_) -> [Char] -> Either [Char] (TestDeal a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (TestDeal a))
-> [Char] -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Account:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
accName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"not found in SwapReceive"
      (Bool
_, Bool
False) -> [Char] -> Either [Char] (TestDeal a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (TestDeal a))
-> [Char] -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Swap:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
sName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"not found in SwapReceive"
      (Bool, Bool)
_ -> let 
              receiveAmt :: Balance
receiveAmt = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
max Balance
0 (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ RateSwap -> Balance
HE.rsNetCash (RateSwap -> Balance) -> RateSwap -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] RateSwap
rtSwap Map [Char] RateSwap -> [Char] -> RateSwap
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
sName
              newRtSwap :: Map [Char] RateSwap
newRtSwap = (RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> RateSwap -> RateSwap
HE.receiveIRS Date
d) [Char]
sName Map [Char] RateSwap
rtSwap
              newAccMap :: Map [Char] Account
newAccMap = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
receiveAmt Date
d ([Char] -> TxnComment
SwapInSettle [Char]
sName)) [Char]
accName Map [Char] Account
accsMap
            in
              TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t { rateSwap = Just newRtSwap, accounts = newAccMap }

performAction Date
d t :: TestDeal a
t@TestDeal{rateSwap :: forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap = Just Map [Char] RateSwap
rtSwap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accsMap } (W.SwapPay [Char]
accName [Char]
sName)
  = case ([Char] -> Map [Char] Account -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member [Char]
accName Map [Char] Account
accsMap, [Char] -> Map [Char] RateSwap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member [Char]
sName Map [Char] RateSwap
rtSwap) of 
      (Bool
False, Bool
_) -> [Char] -> Either [Char] (TestDeal a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (TestDeal a))
-> [Char] -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Account:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
accName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"not found in SwapPay"
      (Bool
_, Bool
False) -> [Char] -> Either [Char] (TestDeal a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (TestDeal a))
-> [Char] -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Date:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Swap:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
sName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"not found in SwapPay"
      (Bool, Bool)
_ -> if (RateSwap -> Balance
HE.rsNetCash (Map [Char] RateSwap
rtSwap Map [Char] RateSwap -> [Char] -> RateSwap
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
sName)) Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance
0 then
             let 
                payoutAmt :: Balance
payoutAmt = Balance -> Balance
forall a. Num a => a -> a
negate (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ RateSwap -> Balance
HE.rsNetCash (RateSwap -> Balance) -> RateSwap -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] RateSwap
rtSwap Map [Char] RateSwap -> [Char] -> RateSwap
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
sName
                availBal :: Balance
availBal = Account -> Balance
A.accBalance (Account -> Balance) -> Account -> Balance
forall a b. (a -> b) -> a -> b
$ Map [Char] Account
accsMap Map [Char] Account -> [Char] -> Account
forall k a. Ord k => Map k a -> k -> a
Map.! [Char]
accName
                amtToPay :: Balance
amtToPay = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
payoutAmt Balance
availBal
                newRtSwap :: Map [Char] RateSwap
newRtSwap = (RateSwap -> RateSwap)
-> [Char] -> Map [Char] RateSwap -> Map [Char] RateSwap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Date -> Balance -> RateSwap -> RateSwap
HE.payoutIRS Date
d Balance
amtToPay) [Char]
sName Map [Char] RateSwap
rtSwap
                newAccMap :: Map [Char] Account
newAccMap = (Account -> Account)
-> [Char] -> Map [Char] Account -> Map [Char] Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.draw Balance
amtToPay Date
d ([Char] -> TxnComment
SwapOutSettle [Char]
sName)) [Char]
accName Map [Char] Account
accsMap
              in
                TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ TestDeal a
t { rateSwap = Just newRtSwap, accounts = newAccMap }
            else
              TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right TestDeal a
t


performAction Date
d t :: TestDeal a
t@TestDeal{rateSwap :: forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap = Just Map [Char] RateSwap
rtSwap, accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accsMap } (W.SwapSettle [Char]
accName [Char]
sName)
  = do
      TestDeal a
t2 <- Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
t ([Char] -> [Char] -> Action
W.SwapReceive [Char]
accName [Char]
sName)
      Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
forall a.
Asset a =>
Date -> TestDeal a -> Action -> Either [Char] (TestDeal a)
performAction Date
d TestDeal a
t2 ([Char] -> [Char] -> Action
W.SwapPay [Char]
accName [Char]
sName)

performAction Date
d t :: TestDeal a
t@TestDeal{ triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map [Char] Trigger))
triggers = Just Map DealCycle (Map [Char] Trigger)
trgM } (W.RunTrigger DealCycle
loc [[Char]]
tNames)
  = do 
      [Trigger]
tList <- Either [Char] [Trigger]
newTrgList
      TestDeal a -> Either [Char] (TestDeal a)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestDeal a -> Either [Char] (TestDeal a))
-> TestDeal a -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$
          let 
            newTrgMap :: Map [Char] Trigger
newTrgMap = [([Char], Trigger)] -> Map [Char] Trigger
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], Trigger)] -> Map [Char] Trigger)
-> [([Char], Trigger)] -> Map [Char] Trigger
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Trigger] -> [([Char], Trigger)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
tNames [Trigger]
tList
          in 
            TestDeal a
t { triggers = Just (Map.insert loc newTrgMap trgM) }
    where 
      triggerM :: Map [Char] Trigger
triggerM = Map DealCycle (Map [Char] Trigger)
trgM Map DealCycle (Map [Char] Trigger)
-> DealCycle -> Map [Char] Trigger
forall k a. Ord k => Map k a -> k -> a
Map.! DealCycle
loc
      triggerList :: [Trigger]
triggerList = (Map [Char] Trigger
triggerM Map [Char] Trigger -> [Char] -> Trigger
forall k a. Ord k => Map k a -> k -> a
Map.!) ([Char] -> Trigger) -> [[Char]] -> [Trigger]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
tNames
      newTrgList :: Either [Char] [Trigger]
newTrgList = (Trigger -> Either [Char] Trigger)
-> [Trigger] -> Either [Char] [Trigger]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM 
                    (TestDeal a -> Date -> Trigger -> Either [Char] Trigger
forall a.
Asset a =>
TestDeal a -> Date -> Trigger -> Either [Char] Trigger
testTrigger TestDeal a
t Date
d)
                    [Trigger]
triggerList


performAction Date
d TestDeal a
t (W.Placeholder Maybe [Char]
mComment) = TestDeal a -> Either [Char] (TestDeal a)
forall a b. b -> Either a b
Right TestDeal a
t 

performAction Date
d TestDeal a
t Action
action =  [Char] -> Either [Char] (TestDeal a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (TestDeal a))
-> [Char] -> Either [Char] (TestDeal a)
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to match action>>"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Action -> [Char]
forall a. Show a => a -> [Char]
show Action
action[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
">>Deal"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> [Char]
show (TestDeal a -> [Char]
forall a. TestDeal a -> [Char]
name TestDeal a
t)