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

module Deal.DealBase (TestDeal(..),SPV(..),dealBonds,dealFees,dealAccounts,dealPool,PoolType(..),getIssuanceStats
                     ,getAllAsset,getAllAssetList,getAllCollectedFrame,getLatestCollectFrame,getAllCollectedTxns
                     ,getIssuanceStatsConsol,getAllCollectedTxnsList
                     ,getPoolIds,getBondByName, UnderlyingDeal(..), uDealFutureTxn,viewDealAllBonds,DateDesp(..),ActionOnDate(..)
                     ,sortActionOnDate,dealBondGroups
                     ,viewDealBondsByNames,poolTypePool,viewBondsInMap,bondGroupsBonds
                     ,increaseBondPaidPeriod,increasePoolCollectedPeriod
                     ,DealStatFields(..),getDealStatInt,isPreClosing,populateDealDates
                     ,bondTraversal,findBondByNames,updateBondInMap
		     ,_MultiPool,_ResecDeal,uDealFutureCf,uDealFutureScheduleCf
                     )                      
  where
import qualified Accounts as A
import qualified Ledger as LD
import qualified Asset as Ast
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 qualified Call as C
import qualified InterestRate as IR
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 Data.DList as DL
import Data.List
import Data.Fixed
import Data.Maybe
import Data.Ratio
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.Lens hiding (element)
import Control.Lens.TH
import Data.IntMap (filterWithKey)
import qualified Data.Text as T
import Text.Read (readMaybe)
import qualified Pool as P
import qualified Types as CF

import Debug.Trace
import qualified Control.Lens as P
debug :: c -> String -> c
debug = (String -> c -> c) -> c -> String -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> c -> c
forall a. String -> a -> a
trace


data DealComp = CompBond 
              | CompAccount 
              | CompFee 
              | CompPool 
              | CompTrigger 
              | CompLedger 
              | CompRateSwap 
              | CompRateCap 
              | CompCurrencySwap 
              | CompLiqProvider 
              deriving (Int -> DealComp -> ShowS
[DealComp] -> ShowS
DealComp -> String
(Int -> DealComp -> ShowS)
-> (DealComp -> String) -> ([DealComp] -> ShowS) -> Show DealComp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DealComp -> ShowS
showsPrec :: Int -> DealComp -> ShowS
$cshow :: DealComp -> String
show :: DealComp -> String
$cshowList :: [DealComp] -> ShowS
showList :: [DealComp] -> ShowS
Show,DealComp -> DealComp -> Bool
(DealComp -> DealComp -> Bool)
-> (DealComp -> DealComp -> Bool) -> Eq DealComp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DealComp -> DealComp -> Bool
== :: DealComp -> DealComp -> Bool
$c/= :: DealComp -> DealComp -> Bool
/= :: DealComp -> DealComp -> Bool
Eq,Eq DealComp
Eq DealComp =>
(DealComp -> DealComp -> Ordering)
-> (DealComp -> DealComp -> Bool)
-> (DealComp -> DealComp -> Bool)
-> (DealComp -> DealComp -> Bool)
-> (DealComp -> DealComp -> Bool)
-> (DealComp -> DealComp -> DealComp)
-> (DealComp -> DealComp -> DealComp)
-> Ord DealComp
DealComp -> DealComp -> Bool
DealComp -> DealComp -> Ordering
DealComp -> DealComp -> DealComp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DealComp -> DealComp -> Ordering
compare :: DealComp -> DealComp -> Ordering
$c< :: DealComp -> DealComp -> Bool
< :: DealComp -> DealComp -> Bool
$c<= :: DealComp -> DealComp -> Bool
<= :: DealComp -> DealComp -> Bool
$c> :: DealComp -> DealComp -> Bool
> :: DealComp -> DealComp -> Bool
$c>= :: DealComp -> DealComp -> Bool
>= :: DealComp -> DealComp -> Bool
$cmax :: DealComp -> DealComp -> DealComp
max :: DealComp -> DealComp -> DealComp
$cmin :: DealComp -> DealComp -> DealComp
min :: DealComp -> DealComp -> DealComp
Ord,(forall x. DealComp -> Rep DealComp x)
-> (forall x. Rep DealComp x -> DealComp) -> Generic DealComp
forall x. Rep DealComp x -> DealComp
forall x. DealComp -> Rep DealComp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DealComp -> Rep DealComp x
from :: forall x. DealComp -> Rep DealComp x
$cto :: forall x. Rep DealComp x -> DealComp
to :: forall x. Rep DealComp x -> DealComp
Generic,ReadPrec [DealComp]
ReadPrec DealComp
Int -> ReadS DealComp
ReadS [DealComp]
(Int -> ReadS DealComp)
-> ReadS [DealComp]
-> ReadPrec DealComp
-> ReadPrec [DealComp]
-> Read DealComp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DealComp
readsPrec :: Int -> ReadS DealComp
$creadList :: ReadS [DealComp]
readList :: ReadS [DealComp]
$creadPrec :: ReadPrec DealComp
readPrec :: ReadPrec DealComp
$creadListPrec :: ReadPrec [DealComp]
readListPrec :: ReadPrec [DealComp]
Read)

data ActionTypeOnDate = DoSettle
                      | DoAccrue
                      | DoUpdateRate

data ActionOnDate = EarnAccInt Date AccName              -- ^ sweep bank account interest
                  | ChangeDealStatusTo Date DealStatus   -- ^ change deal status
                  | AccrueFee Date FeeName               -- ^ accure fee
                  | ResetLiqProvider Date String         -- ^ reset credit for liquidity provider
                  | ResetLiqProviderRate Date String     -- ^ accure interest/premium amount for liquidity provider
                  | PoolCollection Date String           -- ^ collect pool cashflow and deposit to accounts
                  | RunWaterfall Date String             -- ^ execute waterfall on distribution date
                  | DealClosed Date                      -- ^ actions to perform at the deal closing day, and enter a new deal status
                  | FireTrigger Date DealCycle String    -- ^ fire a trigger
                  | InspectDS Date [DealStats]           -- ^ inspect formulas
                  | CalcIRSwap Date String               -- ^ calc interest rate swap dates
                  | SettleIRSwap Date String             -- ^ settle interest rate swap dates
                  | AccrueCapRate Date String            -- ^ reset interest rate cap dates
                  | ResetBondRate Date String            -- ^ reset bond interest rate per bond's interest rate info
                  | StepUpBondRate Date String           -- ^ reset bond interest rate per bond's interest rate info
                  | ResetSrtRate Date String 
                  | ResetAccRate Date String 
                  | AccrueSrt Date String 
                  | MakeWhole Date Spread (Table Float Spread)
                  | IssueBond Date (Maybe Pre) String AccName L.Bond (Maybe DealStats) (Maybe DealStats)
                  | FundBond Date (Maybe Pre) String AccName Amount
                  | RefiBondRate Date AccountName BondName L.InterestInfo
                  | RefiBond Date AccountName L.Bond
                  | BuildReport StartDate EndDate        -- ^ build cashflow report between dates and balance report at end date
                  | StopRunFlag Date                     -- ^ stop the run with a message
                  | StopRunTest Date [Pre]               -- ^ stop the run with a condition
                  | HitStatedMaturity Date               -- ^ hit the stated maturity date
                  | TestCall Date                        -- ^ test call dates
                  deriving (Int -> ActionOnDate -> ShowS
[ActionOnDate] -> ShowS
ActionOnDate -> String
(Int -> ActionOnDate -> ShowS)
-> (ActionOnDate -> String)
-> ([ActionOnDate] -> ShowS)
-> Show ActionOnDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionOnDate -> ShowS
showsPrec :: Int -> ActionOnDate -> ShowS
$cshow :: ActionOnDate -> String
show :: ActionOnDate -> String
$cshowList :: [ActionOnDate] -> ShowS
showList :: [ActionOnDate] -> ShowS
Show,(forall x. ActionOnDate -> Rep ActionOnDate x)
-> (forall x. Rep ActionOnDate x -> ActionOnDate)
-> Generic ActionOnDate
forall x. Rep ActionOnDate x -> ActionOnDate
forall x. ActionOnDate -> Rep ActionOnDate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionOnDate -> Rep ActionOnDate x
from :: forall x. ActionOnDate -> Rep ActionOnDate x
$cto :: forall x. Rep ActionOnDate x -> ActionOnDate
to :: forall x. Rep ActionOnDate x -> ActionOnDate
Generic,ReadPrec [ActionOnDate]
ReadPrec ActionOnDate
Int -> ReadS ActionOnDate
ReadS [ActionOnDate]
(Int -> ReadS ActionOnDate)
-> ReadS [ActionOnDate]
-> ReadPrec ActionOnDate
-> ReadPrec [ActionOnDate]
-> Read ActionOnDate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ActionOnDate
readsPrec :: Int -> ReadS ActionOnDate
$creadList :: ReadS [ActionOnDate]
readList :: ReadS [ActionOnDate]
$creadPrec :: ReadPrec ActionOnDate
readPrec :: ReadPrec ActionOnDate
$creadListPrec :: ReadPrec [ActionOnDate]
readListPrec :: ReadPrec [ActionOnDate]
Read)

instance Ord ActionOnDate where
  compare :: ActionOnDate -> ActionOnDate -> Ordering
compare ActionOnDate
a1 ActionOnDate
a2 = Date -> Date -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
a1) (ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
a2)

instance Eq ActionOnDate where
  ActionOnDate
a1 == :: ActionOnDate -> ActionOnDate -> Bool
== ActionOnDate
a2 = ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
a1 Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
a2


instance TimeSeries ActionOnDate where
    getDate :: ActionOnDate -> Date
getDate (RunWaterfall Date
d String
_) = Date
d
    getDate (ResetLiqProvider Date
d String
_) = Date
d
    getDate (PoolCollection Date
d String
_) = Date
d
    getDate (EarnAccInt Date
d String
_) = Date
d
    getDate (AccrueFee Date
d String
_) = Date
d
    getDate (DealClosed Date
d) = Date
d
    getDate (FireTrigger Date
d DealCycle
_ String
_) = Date
d
    getDate (ChangeDealStatusTo Date
d DealStatus
_ ) = Date
d
    getDate (InspectDS Date
d [DealStats]
_ ) = Date
d
    getDate (CalcIRSwap Date
d String
_ ) = Date
d
    getDate (SettleIRSwap Date
d String
_ ) = Date
d
    getDate (AccrueCapRate Date
d String
_ ) = Date
d
    getDate (ResetBondRate Date
d String
_) = Date
d 
    getDate (StepUpBondRate Date
d String
_) = Date
d 
    getDate (ResetAccRate Date
d String
_ ) = Date
d 
    getDate (MakeWhole Date
d Spread
_ Table Float Spread
_) = Date
d 
    getDate (BuildReport Date
sd Date
ed) = Date
ed
    getDate (IssueBond Date
d Maybe Pre
_ String
_ String
_ Bond
_ Maybe DealStats
_ Maybe DealStats
_) = Date
d
    getDate (RefiBondRate Date
d String
_ String
_ InterestInfo
_) = Date
d
    getDate (RefiBond Date
d String
_ Bond
_) = Date
d
    getDate (ResetLiqProviderRate Date
d String
_) = Date
d
    getDate (TestCall Date
d) = Date
d
    getDate (FundBond Date
d Maybe Pre
_ String
_ String
_ Amount
_) = Date
d
    getDate (HitStatedMaturity Date
d) = Date
d
    getDate (StopRunTest Date
d [Pre]
_) = Date
d
    getDate ActionOnDate
x = String -> Date
forall a. HasCallStack => String -> a
error (String -> Date) -> String -> Date
forall a b. (a -> b) -> a -> b
$ String
"Failed to match"String -> ShowS
forall a. [a] -> [a] -> [a]
++ ActionOnDate -> String
forall a. Show a => a -> String
show ActionOnDate
x


sortActionOnDate :: ActionOnDate -> ActionOnDate -> Ordering
sortActionOnDate :: ActionOnDate -> ActionOnDate -> Ordering
sortActionOnDate ActionOnDate
a1 ActionOnDate
a2 
  | Date
d1 Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== Date
d2 = case (ActionOnDate
a1,ActionOnDate
a2) of
                  (PoolCollection {}, DealClosed {}) -> Ordering
LT -- pool collection should be executed before deal closed
                  (DealClosed {}, PoolCollection {}) -> Ordering
GT -- pool collection should be executed before deal closed
                  (BuildReport Date
sd1 Date
ed1 ,ActionOnDate
_) -> Ordering
GT  -- build report should be executed last
                  (ActionOnDate
_ , BuildReport Date
sd1 Date
ed1) -> Ordering
LT -- build report should be executed last
                  (TestCall Date
_ ,ActionOnDate
_) -> Ordering
GT  -- test call should be executed last
                  (ActionOnDate
_ , TestCall Date
_) -> Ordering
LT -- test call should be executed last
                  (CalcIRSwap Date
_ String
_ ,SettleIRSwap Date
_ String
_) -> Ordering
LT  -- reset interest swap should be first
                  (SettleIRSwap Date
_ String
_ ,CalcIRSwap Date
_ String
_) -> Ordering
GT  -- reset interest swap should be first
                  (ActionOnDate
_ , CalcIRSwap Date
_ String
_) -> Ordering
GT -- reset interest swap should be first
                  (CalcIRSwap Date
_ String
_ ,ActionOnDate
_) -> Ordering
LT  -- reset interest swap should be first
                  (ActionOnDate
_ , CalcIRSwap Date
_ String
_) -> Ordering
GT -- reset interest swap should be first
                  (StepUpBondRate {} ,ActionOnDate
_) -> Ordering
LT  -- step up bond rate should be first
                  (ActionOnDate
_ , StepUpBondRate {}) -> Ordering
GT -- step up bond rate should be first
                  (ResetBondRate {} ,ActionOnDate
_) -> Ordering
LT  -- reset bond rate should be first
                  (ActionOnDate
_ , ResetBondRate {}) -> Ordering
GT -- reset bond rate should be first
                  (EarnAccInt {} ,ActionOnDate
_) -> Ordering
LT  -- earn should be first
                  (ActionOnDate
_ , EarnAccInt {}) -> Ordering
GT -- earn should be first
                  (ResetLiqProvider {} ,ActionOnDate
_) -> Ordering
LT  -- reset liq be first
                  (ActionOnDate
_ , ResetLiqProvider {}) -> Ordering
GT -- reset liq be first
                  (PoolCollection {}, RunWaterfall {}) -> Ordering
LT -- pool collection should be executed before waterfall
                  (RunWaterfall {}, PoolCollection {}) -> Ordering
GT -- pool collection should be executed before waterfall
                  (ActionOnDate
_,ActionOnDate
_) -> Ordering
EQ 
  | Bool
otherwise = Date -> Date -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Date
d1 Date
d2
  where 
    d1 :: Date
d1 = ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
a1 
    d2 :: Date
d2 = ActionOnDate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate ActionOnDate
a2 


type CutoffDate = Date
type ClosingDate = Date
type RevolvingDate = Date
type StatedDate = Date
type DistributionDates = DatePattern
type PoolCollectionDates = DatePattern


data DateDesp = PreClosingDates CutoffDate ClosingDate (Maybe RevolvingDate) StatedDate (Date,PoolCollectionDates) (Date,DistributionDates)
              -- <Pool Collection DP> <Waterfall DP> 
              --  (last collect,last pay), mRevolving end-date dp1-pool-pay dp2-bond-pay
              | CurrentDates (Date,Date) (Maybe Date) StatedDate (Date,PoolCollectionDates) (Date,DistributionDates)
              -- Dict based 
              | GenericDates (Map.Map DateType DatePattern)
              deriving (Int -> DateDesp -> ShowS
[DateDesp] -> ShowS
DateDesp -> String
(Int -> DateDesp -> ShowS)
-> (DateDesp -> String) -> ([DateDesp] -> ShowS) -> Show DateDesp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateDesp -> ShowS
showsPrec :: Int -> DateDesp -> ShowS
$cshow :: DateDesp -> String
show :: DateDesp -> String
$cshowList :: [DateDesp] -> ShowS
showList :: [DateDesp] -> ShowS
Show,DateDesp -> DateDesp -> Bool
(DateDesp -> DateDesp -> Bool)
-> (DateDesp -> DateDesp -> Bool) -> Eq DateDesp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DateDesp -> DateDesp -> Bool
== :: DateDesp -> DateDesp -> Bool
$c/= :: DateDesp -> DateDesp -> Bool
/= :: DateDesp -> DateDesp -> Bool
Eq, (forall x. DateDesp -> Rep DateDesp x)
-> (forall x. Rep DateDesp x -> DateDesp) -> Generic DateDesp
forall x. Rep DateDesp x -> DateDesp
forall x. DateDesp -> Rep DateDesp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DateDesp -> Rep DateDesp x
from :: forall x. DateDesp -> Rep DateDesp x
$cto :: forall x. Rep DateDesp x -> DateDesp
to :: forall x. Rep DateDesp x -> DateDesp
Generic,Eq DateDesp
Eq DateDesp =>
(DateDesp -> DateDesp -> Ordering)
-> (DateDesp -> DateDesp -> Bool)
-> (DateDesp -> DateDesp -> Bool)
-> (DateDesp -> DateDesp -> Bool)
-> (DateDesp -> DateDesp -> Bool)
-> (DateDesp -> DateDesp -> DateDesp)
-> (DateDesp -> DateDesp -> DateDesp)
-> Ord DateDesp
DateDesp -> DateDesp -> Bool
DateDesp -> DateDesp -> Ordering
DateDesp -> DateDesp -> DateDesp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DateDesp -> DateDesp -> Ordering
compare :: DateDesp -> DateDesp -> Ordering
$c< :: DateDesp -> DateDesp -> Bool
< :: DateDesp -> DateDesp -> Bool
$c<= :: DateDesp -> DateDesp -> Bool
<= :: DateDesp -> DateDesp -> Bool
$c> :: DateDesp -> DateDesp -> Bool
> :: DateDesp -> DateDesp -> Bool
$c>= :: DateDesp -> DateDesp -> Bool
>= :: DateDesp -> DateDesp -> Bool
$cmax :: DateDesp -> DateDesp -> DateDesp
max :: DateDesp -> DateDesp -> DateDesp
$cmin :: DateDesp -> DateDesp -> DateDesp
min :: DateDesp -> DateDesp -> DateDesp
Ord)


populateDealDates :: DateDesp -> DealStatus -> Either String (Date,Date,Date,[ActionOnDate],[ActionOnDate],Date,[ActionOnDate])
populateDealDates :: DateDesp
-> DealStatus
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
populateDealDates (PreClosingDates Date
cutoff Date
closing Maybe Date
mRevolving Date
end (Date
firstCollect,PoolCollectionDates
poolDp) (Date
firstPay,PoolCollectionDates
bondDp)) DealStatus
_
  = (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
 [ActionOnDate])
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
forall a b. b -> Either a b
Right (Date
cutoff,Date
closing,Date
firstPay,[ActionOnDate]
pa,[ActionOnDate]
ba,Date
end, []) 
    where 
      pa :: [ActionOnDate]
pa = [ Date -> String -> ActionOnDate
PoolCollection Date
_d String
"" | Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
IE Date
firstCollect PoolCollectionDates
poolDp Date
end ]
      ba :: [ActionOnDate]
ba = [ Date -> String -> ActionOnDate
RunWaterfall Date
_d String
"" | Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
IE Date
firstPay PoolCollectionDates
bondDp Date
end ]

populateDealDates (CurrentDates (Date
lastCollect,Date
lastPay) Maybe Date
mRevolving Date
end (Date
nextCollect,PoolCollectionDates
poolDp) (Date
nextPay,PoolCollectionDates
bondDp)) DealStatus
_
  = (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
 [ActionOnDate])
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
forall a b. b -> Either a b
Right (Date
lastCollect, Date
lastPay,[Date] -> Date
forall a. HasCallStack => [a] -> a
head [Date]
futurePayDates, [ActionOnDate]
pa, [ActionOnDate]
ba, Date
end, []) 
    where 
      futurePayDates :: [Date]
futurePayDates = RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
IE Date
nextPay PoolCollectionDates
bondDp Date
end 
      ba :: [ActionOnDate]
ba = [ Date -> String -> ActionOnDate
RunWaterfall Date
_d String
"" | Date
_d <- [Date]
futurePayDates]
      futureCollectDates :: [Date]
futureCollectDates = RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
IE Date
nextCollect PoolCollectionDates
poolDp Date
end 
      pa :: [ActionOnDate]
pa = [ Date -> String -> ActionOnDate
PoolCollection Date
_d String
"" | Date
_d <- [Date]
futureCollectDates]

populateDealDates (GenericDates Map DateType PoolCollectionDates
m) 
                  (PreClosing DealStatus
_)
  = let 
      requiredFields :: (DateType, DateType, DateType, DateType, DateType, DateType)
requiredFields = (DateType
CutoffDate, DateType
ClosingDate, DateType
FirstPayDate, DateType
StatedMaturityDate
                        , DateType
DistributionDates, DateType
CollectionDates) 
      vals :: (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates)
vals = (DateType, DateType, DateType, DateType, DateType, DateType)
-> Map DateType PoolCollectionDates
-> (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
    Maybe PoolCollectionDates, Maybe PoolCollectionDates,
    Maybe PoolCollectionDates, Maybe PoolCollectionDates)
forall k v.
Ord k =>
(k, k, k, k, k, k)
-> Map k v
-> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v)
lookupTuple6 (DateType, DateType, DateType, DateType, DateType, DateType)
requiredFields Map DateType PoolCollectionDates
m
      
      isCustomWaterfallKey :: DateType -> p -> Bool
isCustomWaterfallKey (CustomExeDates String
_) p
_ = Bool
True
      isCustomWaterfallKey DateType
_ p
_ = Bool
False
      custWaterfall :: [(DateType, PoolCollectionDates)]
custWaterfall = Map DateType PoolCollectionDates
-> [(DateType, PoolCollectionDates)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map DateType PoolCollectionDates
 -> [(DateType, PoolCollectionDates)])
-> Map DateType PoolCollectionDates
-> [(DateType, PoolCollectionDates)]
forall a b. (a -> b) -> a -> b
$ (DateType -> PoolCollectionDates -> Bool)
-> Map DateType PoolCollectionDates
-> Map DateType PoolCollectionDates
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey DateType -> PoolCollectionDates -> Bool
forall {p}. DateType -> p -> Bool
isCustomWaterfallKey Map DateType PoolCollectionDates
m
    in 
      case (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates)
vals of
        (Just (SingletonDate Date
coffDate), Just (SingletonDate Date
closingDate), Just (SingletonDate Date
fPayDate)
          , Just (SingletonDate Date
statedDate), Just PoolCollectionDates
bondDp, Just PoolCollectionDates
poolDp)
          -> let 
                pa :: [ActionOnDate]
pa = [ Date -> String -> ActionOnDate
PoolCollection Date
_d String
"" | Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
IE Date
closingDate PoolCollectionDates
poolDp Date
statedDate ]
                ba :: [ActionOnDate]
ba = [ Date -> String -> ActionOnDate
RunWaterfall Date
_d String
"" | Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
IE Date
fPayDate PoolCollectionDates
bondDp Date
statedDate ]
                cu :: [ActionOnDate]
cu = [ Date -> String -> ActionOnDate
RunWaterfall Date
_d String
custName | (CustomExeDates String
custName, PoolCollectionDates
custDp) <- [(DateType, PoolCollectionDates)]
custWaterfall
                                                , Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
EE Date
closingDate PoolCollectionDates
custDp Date
statedDate ]
              in 
                (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
 [ActionOnDate])
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
forall a b. b -> Either a b
Right (Date
coffDate, Date
closingDate, Date
fPayDate, [ActionOnDate]
pa, [ActionOnDate]
ba, Date
statedDate, [ActionOnDate]
cu)
        (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates)
_ 
          -> String
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
forall a b. a -> Either a b
Left String
"Missing required dates in GenericDates in deal status PreClosing"

populateDealDates (GenericDates Map DateType PoolCollectionDates
m) DealStatus
_ 
  = let 
      requiredFields :: (DateType, DateType, DateType, DateType, DateType, DateType)
requiredFields = (DateType
LastCollectDate, DateType
LastPayDate, DateType
NextPayDate, DateType
StatedMaturityDate
                        , DateType
DistributionDates, DateType
CollectionDates) 
      vals :: (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates)
vals = (DateType, DateType, DateType, DateType, DateType, DateType)
-> Map DateType PoolCollectionDates
-> (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
    Maybe PoolCollectionDates, Maybe PoolCollectionDates,
    Maybe PoolCollectionDates, Maybe PoolCollectionDates)
forall k v.
Ord k =>
(k, k, k, k, k, k)
-> Map k v
-> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v)
lookupTuple6 (DateType, DateType, DateType, DateType, DateType, DateType)
requiredFields Map DateType PoolCollectionDates
m
      
      isCustomWaterfallKey :: DateType -> p -> Bool
isCustomWaterfallKey (CustomExeDates String
_) p
_ = Bool
True
      isCustomWaterfallKey DateType
_ p
_ = Bool
False
      custWaterfall :: [(DateType, PoolCollectionDates)]
custWaterfall = Map DateType PoolCollectionDates
-> [(DateType, PoolCollectionDates)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map DateType PoolCollectionDates
 -> [(DateType, PoolCollectionDates)])
-> Map DateType PoolCollectionDates
-> [(DateType, PoolCollectionDates)]
forall a b. (a -> b) -> a -> b
$ (DateType -> PoolCollectionDates -> Bool)
-> Map DateType PoolCollectionDates
-> Map DateType PoolCollectionDates
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey DateType -> PoolCollectionDates -> Bool
forall {p}. DateType -> p -> Bool
isCustomWaterfallKey Map DateType PoolCollectionDates
m
    in 
      case (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates)
vals of
        (Just (SingletonDate Date
lastCollect), Just (SingletonDate Date
lastPayDate), Just (SingletonDate Date
nextPayDate)
          , Just (SingletonDate Date
statedDate), Just PoolCollectionDates
bondDp, Just PoolCollectionDates
poolDp)
          -> let 
                pa :: [ActionOnDate]
pa = [ Date -> String -> ActionOnDate
PoolCollection Date
_d String
"" | Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
EE Date
lastCollect PoolCollectionDates
poolDp Date
statedDate ]
                ba :: [ActionOnDate]
ba = [ Date -> String -> ActionOnDate
RunWaterfall Date
_d String
"" | Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
IE Date
nextPayDate PoolCollectionDates
bondDp Date
statedDate ]
                cu :: [ActionOnDate]
cu = [ Date -> String -> ActionOnDate
RunWaterfall Date
_d String
custName | (CustomExeDates String
custName, PoolCollectionDates
custDp) <- [(DateType, PoolCollectionDates)]
custWaterfall
                                                , Date
_d <- RangeType -> Date -> PoolCollectionDates -> Date -> [Date]
genSerialDatesTill2 RangeType
EE Date
lastCollect PoolCollectionDates
custDp Date
statedDate ]
              in 
                (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
 [ActionOnDate])
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
forall a b. b -> Either a b
Right (Date
lastCollect, Date
lastPayDate, Date
nextPayDate, [ActionOnDate]
pa, [ActionOnDate]
ba, Date
statedDate, [ActionOnDate]
cu) -- `debug` ("custom action"++ show cu)
        (Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates,
 Maybe PoolCollectionDates, Maybe PoolCollectionDates)
_ 
          -> String
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
forall a b. a -> Either a b
Left String
"Missing required dates in GenericDates in deal status PreClosing"



class SPV a where
  getBondsByName :: a -> Maybe [String] -> Map.Map String L.Bond
  getActiveBonds :: a -> [String] -> [L.Bond]
  getBondBegBal :: a -> String -> Balance
  getBondStmtByName :: a -> Maybe [String] -> Map.Map String (Maybe Statement)
  getFeeByName :: a -> Maybe [String] -> Map.Map String F.Fee
  getAccountByName :: a -> Maybe [String] -> Map.Map String A.Account
  isResec :: a -> Bool
  getNextBondPayDate :: a -> Date
  getOustandingBal :: a -> Balance


type BalDealStatMap = Map.Map DealStatFields Balance
type RDealStatMap = Map.Map DealStatFields Rate
type BDealStatMap = Map.Map DealStatFields Bool
type IDealStatMap = Map.Map DealStatFields Int

data TestDeal a = TestDeal { forall a. TestDeal a -> String
name :: DealName
                            ,forall a. TestDeal a -> DealStatus
status :: DealStatus
                            ,forall a. TestDeal a -> DateDesp
dates :: DateDesp
                            ,forall a. TestDeal a -> Map String Account
accounts :: Map.Map AccountName A.Account
                            ,forall a. TestDeal a -> Map String Fee
fees :: Map.Map FeeName F.Fee
                            ,forall a. TestDeal a -> Map String Bond
bonds :: Map.Map BondName L.Bond
                            ,forall a. TestDeal a -> PoolType a
pool ::  PoolType a 
                            ,forall a. TestDeal a -> Map ActionWhen DistributionSeq
waterfall :: Map.Map W.ActionWhen W.DistributionSeq
                            ,forall a. TestDeal a -> [CollectionRule]
collects :: [W.CollectionRule]
                            ,forall a.
TestDeal a
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
stats :: (BalDealStatMap,RDealStatMap,BDealStatMap,IDealStatMap)
                            ,forall a. TestDeal a -> Maybe (Map String LiqFacility)
liqProvider :: Maybe (Map.Map String CE.LiqFacility)
                            ,forall a. TestDeal a -> Maybe (Map String RateSwap)
rateSwap :: Maybe (Map.Map String HE.RateSwap)
                            ,forall a. TestDeal a -> Maybe (Map String RateCap)
rateCap :: Maybe (Map.Map String HE.RateCap)
                            ,forall a. TestDeal a -> Maybe (Map String CurrencySwap)
currencySwap :: Maybe (Map.Map String HE.CurrencySwap)
                            ,forall a. TestDeal a -> Maybe (Map String CustomDataType)
custom:: Maybe (Map.Map String CustomDataType)
                            ,forall a. TestDeal a -> Maybe (Map DealCycle (Map String Trigger))
triggers :: Maybe (Map.Map DealCycle (Map.Map String Trigger))
                            ,forall a. TestDeal a -> Maybe (Map String Ledger)
ledgers :: Maybe (Map.Map String LD.Ledger)
                            } deriving (Int -> TestDeal a -> ShowS
[TestDeal a] -> ShowS
TestDeal a -> String
(Int -> TestDeal a -> ShowS)
-> (TestDeal a -> String)
-> ([TestDeal a] -> ShowS)
-> Show (TestDeal a)
forall a. Show a => Int -> TestDeal a -> ShowS
forall a. Show a => [TestDeal a] -> ShowS
forall a. Show a => TestDeal a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TestDeal a -> ShowS
showsPrec :: Int -> TestDeal a -> ShowS
$cshow :: forall a. Show a => TestDeal a -> String
show :: TestDeal a -> String
$cshowList :: forall a. Show a => [TestDeal a] -> ShowS
showList :: [TestDeal a] -> ShowS
Show,(forall x. TestDeal a -> Rep (TestDeal a) x)
-> (forall x. Rep (TestDeal a) x -> TestDeal a)
-> Generic (TestDeal a)
forall x. Rep (TestDeal a) x -> TestDeal a
forall x. TestDeal a -> Rep (TestDeal a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TestDeal a) x -> TestDeal a
forall a x. TestDeal a -> Rep (TestDeal a) x
$cfrom :: forall a x. TestDeal a -> Rep (TestDeal a) x
from :: forall x. TestDeal a -> Rep (TestDeal a) x
$cto :: forall a x. Rep (TestDeal a) x -> TestDeal a
to :: forall x. Rep (TestDeal a) x -> TestDeal a
Generic,TestDeal a -> TestDeal a -> Bool
(TestDeal a -> TestDeal a -> Bool)
-> (TestDeal a -> TestDeal a -> Bool) -> Eq (TestDeal a)
forall a. Eq a => TestDeal a -> TestDeal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TestDeal a -> TestDeal a -> Bool
== :: TestDeal a -> TestDeal a -> Bool
$c/= :: forall a. Eq a => TestDeal a -> TestDeal a -> Bool
/= :: TestDeal a -> TestDeal a -> Bool
Eq,Eq (TestDeal a)
Eq (TestDeal a) =>
(TestDeal a -> TestDeal a -> Ordering)
-> (TestDeal a -> TestDeal a -> Bool)
-> (TestDeal a -> TestDeal a -> Bool)
-> (TestDeal a -> TestDeal a -> Bool)
-> (TestDeal a -> TestDeal a -> Bool)
-> (TestDeal a -> TestDeal a -> TestDeal a)
-> (TestDeal a -> TestDeal a -> TestDeal a)
-> Ord (TestDeal a)
TestDeal a -> TestDeal a -> Bool
TestDeal a -> TestDeal a -> Ordering
TestDeal a -> TestDeal a -> TestDeal a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (TestDeal a)
forall a. Ord a => TestDeal a -> TestDeal a -> Bool
forall a. Ord a => TestDeal a -> TestDeal a -> Ordering
forall a. Ord a => TestDeal a -> TestDeal a -> TestDeal a
$ccompare :: forall a. Ord a => TestDeal a -> TestDeal a -> Ordering
compare :: TestDeal a -> TestDeal a -> Ordering
$c< :: forall a. Ord a => TestDeal a -> TestDeal a -> Bool
< :: TestDeal a -> TestDeal a -> Bool
$c<= :: forall a. Ord a => TestDeal a -> TestDeal a -> Bool
<= :: TestDeal a -> TestDeal a -> Bool
$c> :: forall a. Ord a => TestDeal a -> TestDeal a -> Bool
> :: TestDeal a -> TestDeal a -> Bool
$c>= :: forall a. Ord a => TestDeal a -> TestDeal a -> Bool
>= :: TestDeal a -> TestDeal a -> Bool
$cmax :: forall a. Ord a => TestDeal a -> TestDeal a -> TestDeal a
max :: TestDeal a -> TestDeal a -> TestDeal a
$cmin :: forall a. Ord a => TestDeal a -> TestDeal a -> TestDeal a
min :: TestDeal a -> TestDeal a -> TestDeal a
Ord)

data UnderlyingDeal a = UnderlyingDeal {
  forall a. UnderlyingDeal a -> TestDeal a
deal :: TestDeal a
  ,forall a. UnderlyingDeal a -> CashFlowFrame
futureCf :: CF.CashFlowFrame
  ,forall a. UnderlyingDeal a -> CashFlowFrame
futureScheduleCf :: CF.CashFlowFrame
  ,forall a. UnderlyingDeal a -> Maybe (Map CutoffFields Amount)
issuanceStat :: Maybe (Map.Map CutoffFields Balance)
} deriving ((forall x. UnderlyingDeal a -> Rep (UnderlyingDeal a) x)
-> (forall x. Rep (UnderlyingDeal a) x -> UnderlyingDeal a)
-> Generic (UnderlyingDeal a)
forall x. Rep (UnderlyingDeal a) x -> UnderlyingDeal a
forall x. UnderlyingDeal a -> Rep (UnderlyingDeal a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (UnderlyingDeal a) x -> UnderlyingDeal a
forall a x. UnderlyingDeal a -> Rep (UnderlyingDeal a) x
$cfrom :: forall a x. UnderlyingDeal a -> Rep (UnderlyingDeal a) x
from :: forall x. UnderlyingDeal a -> Rep (UnderlyingDeal a) x
$cto :: forall a x. Rep (UnderlyingDeal a) x -> UnderlyingDeal a
to :: forall x. Rep (UnderlyingDeal a) x -> UnderlyingDeal a
Generic,UnderlyingDeal a -> UnderlyingDeal a -> Bool
(UnderlyingDeal a -> UnderlyingDeal a -> Bool)
-> (UnderlyingDeal a -> UnderlyingDeal a -> Bool)
-> Eq (UnderlyingDeal a)
forall a. Eq a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
== :: UnderlyingDeal a -> UnderlyingDeal a -> Bool
$c/= :: forall a. Eq a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
/= :: UnderlyingDeal a -> UnderlyingDeal a -> Bool
Eq,Eq (UnderlyingDeal a)
Eq (UnderlyingDeal a) =>
(UnderlyingDeal a -> UnderlyingDeal a -> Ordering)
-> (UnderlyingDeal a -> UnderlyingDeal a -> Bool)
-> (UnderlyingDeal a -> UnderlyingDeal a -> Bool)
-> (UnderlyingDeal a -> UnderlyingDeal a -> Bool)
-> (UnderlyingDeal a -> UnderlyingDeal a -> Bool)
-> (UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a)
-> (UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a)
-> Ord (UnderlyingDeal a)
UnderlyingDeal a -> UnderlyingDeal a -> Bool
UnderlyingDeal a -> UnderlyingDeal a -> Ordering
UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (UnderlyingDeal a)
forall a. Ord a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
forall a. Ord a => UnderlyingDeal a -> UnderlyingDeal a -> Ordering
forall a.
Ord a =>
UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a
$ccompare :: forall a. Ord a => UnderlyingDeal a -> UnderlyingDeal a -> Ordering
compare :: UnderlyingDeal a -> UnderlyingDeal a -> Ordering
$c< :: forall a. Ord a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
< :: UnderlyingDeal a -> UnderlyingDeal a -> Bool
$c<= :: forall a. Ord a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
<= :: UnderlyingDeal a -> UnderlyingDeal a -> Bool
$c> :: forall a. Ord a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
> :: UnderlyingDeal a -> UnderlyingDeal a -> Bool
$c>= :: forall a. Ord a => UnderlyingDeal a -> UnderlyingDeal a -> Bool
>= :: UnderlyingDeal a -> UnderlyingDeal a -> Bool
$cmax :: forall a.
Ord a =>
UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a
max :: UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a
$cmin :: forall a.
Ord a =>
UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a
min :: UnderlyingDeal a -> UnderlyingDeal a -> UnderlyingDeal a
Ord,Int -> UnderlyingDeal a -> ShowS
[UnderlyingDeal a] -> ShowS
UnderlyingDeal a -> String
(Int -> UnderlyingDeal a -> ShowS)
-> (UnderlyingDeal a -> String)
-> ([UnderlyingDeal a] -> ShowS)
-> Show (UnderlyingDeal a)
forall a. Show a => Int -> UnderlyingDeal a -> ShowS
forall a. Show a => [UnderlyingDeal a] -> ShowS
forall a. Show a => UnderlyingDeal a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> UnderlyingDeal a -> ShowS
showsPrec :: Int -> UnderlyingDeal a -> ShowS
$cshow :: forall a. Show a => UnderlyingDeal a -> String
show :: UnderlyingDeal a -> String
$cshowList :: forall a. Show a => [UnderlyingDeal a] -> ShowS
showList :: [UnderlyingDeal a] -> ShowS
Show)

uDealFutureScheduleCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame
uDealFutureScheduleCf :: forall a. Asset a => Lens' (UnderlyingDeal a) CashFlowFrame
uDealFutureScheduleCf = (UnderlyingDeal a -> CashFlowFrame)
-> (UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a)
-> Lens
     (UnderlyingDeal a) (UnderlyingDeal a) CashFlowFrame CashFlowFrame
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UnderlyingDeal a -> CashFlowFrame
forall a. UnderlyingDeal a -> CashFlowFrame
getter UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a
forall {a}. UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a
setter
  where 
    getter :: UnderlyingDeal a -> CashFlowFrame
getter = UnderlyingDeal a -> CashFlowFrame
forall a. UnderlyingDeal a -> CashFlowFrame
futureScheduleCf
    setter :: UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a
setter UnderlyingDeal a
ud CashFlowFrame
newCf = UnderlyingDeal a
ud {futureScheduleCf = newCf}

uDealFutureCf :: Ast.Asset a => Lens' (UnderlyingDeal a) CF.CashFlowFrame
uDealFutureCf :: forall a. Asset a => Lens' (UnderlyingDeal a) CashFlowFrame
uDealFutureCf = (UnderlyingDeal a -> CashFlowFrame)
-> (UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a)
-> Lens
     (UnderlyingDeal a) (UnderlyingDeal a) CashFlowFrame CashFlowFrame
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UnderlyingDeal a -> CashFlowFrame
forall a. UnderlyingDeal a -> CashFlowFrame
getter UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a
forall {a}. UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a
setter
  where 
    getter :: UnderlyingDeal a -> CashFlowFrame
getter = UnderlyingDeal a -> CashFlowFrame
forall a. UnderlyingDeal a -> CashFlowFrame
futureCf
    setter :: UnderlyingDeal a -> CashFlowFrame -> UnderlyingDeal a
setter UnderlyingDeal a
ud CashFlowFrame
newCf = UnderlyingDeal a
ud {futureCf = newCf}

uDealFutureTxn :: Ast.Asset a => Lens' (UnderlyingDeal a) [CF.TsRow]
uDealFutureTxn :: forall a. Asset a => Lens' (UnderlyingDeal a) [TsRow]
uDealFutureTxn = (UnderlyingDeal a -> [TsRow])
-> (UnderlyingDeal a -> [TsRow] -> UnderlyingDeal a)
-> Lens (UnderlyingDeal a) (UnderlyingDeal a) [TsRow] [TsRow]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UnderlyingDeal a -> [TsRow]
forall {a}. UnderlyingDeal a -> [TsRow]
getter UnderlyingDeal a -> [TsRow] -> UnderlyingDeal a
forall {a}. UnderlyingDeal a -> [TsRow] -> UnderlyingDeal a
setter
  where 
    getter :: UnderlyingDeal a -> [TsRow]
getter UnderlyingDeal a
ud = 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 -> [TsRow]) -> CashFlowFrame -> [TsRow]
forall a b. (a -> b) -> a -> b
$ UnderlyingDeal a -> CashFlowFrame
forall a. UnderlyingDeal a -> CashFlowFrame
futureCf UnderlyingDeal a
ud
    setter :: UnderlyingDeal a -> [TsRow] -> UnderlyingDeal a
setter UnderlyingDeal a
ud [TsRow]
newTxn = UnderlyingDeal a
ud {futureCf = CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn}
        -- let 
        --    mOriginalCfFrame = futureCf ud 
        -- in 
        --    case mOriginalCfFrame of 
        --      
        --      (CF.CashFlowFrame (begBal,begDate,mInt) txns) -> ud {futureCf = CF.CashFlowFrame (0,toDate "19000101",Nothing) newTxn }


data PoolType a = MultiPool (Map.Map PoolId (P.Pool a))
                | ResecDeal (Map.Map PoolId (UnderlyingDeal a))
                deriving ((forall x. PoolType a -> Rep (PoolType a) x)
-> (forall x. Rep (PoolType a) x -> PoolType a)
-> Generic (PoolType a)
forall x. Rep (PoolType a) x -> PoolType a
forall x. PoolType a -> Rep (PoolType a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PoolType a) x -> PoolType a
forall a x. PoolType a -> Rep (PoolType a) x
$cfrom :: forall a x. PoolType a -> Rep (PoolType a) x
from :: forall x. PoolType a -> Rep (PoolType a) x
$cto :: forall a x. Rep (PoolType a) x -> PoolType a
to :: forall x. Rep (PoolType a) x -> PoolType a
Generic, PoolType a -> PoolType a -> Bool
(PoolType a -> PoolType a -> Bool)
-> (PoolType a -> PoolType a -> Bool) -> Eq (PoolType a)
forall a. Eq a => PoolType a -> PoolType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PoolType a -> PoolType a -> Bool
== :: PoolType a -> PoolType a -> Bool
$c/= :: forall a. Eq a => PoolType a -> PoolType a -> Bool
/= :: PoolType a -> PoolType a -> Bool
Eq, Eq (PoolType a)
Eq (PoolType a) =>
(PoolType a -> PoolType a -> Ordering)
-> (PoolType a -> PoolType a -> Bool)
-> (PoolType a -> PoolType a -> Bool)
-> (PoolType a -> PoolType a -> Bool)
-> (PoolType a -> PoolType a -> Bool)
-> (PoolType a -> PoolType a -> PoolType a)
-> (PoolType a -> PoolType a -> PoolType a)
-> Ord (PoolType a)
PoolType a -> PoolType a -> Bool
PoolType a -> PoolType a -> Ordering
PoolType a -> PoolType a -> PoolType a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PoolType a)
forall a. Ord a => PoolType a -> PoolType a -> Bool
forall a. Ord a => PoolType a -> PoolType a -> Ordering
forall a. Ord a => PoolType a -> PoolType a -> PoolType a
$ccompare :: forall a. Ord a => PoolType a -> PoolType a -> Ordering
compare :: PoolType a -> PoolType a -> Ordering
$c< :: forall a. Ord a => PoolType a -> PoolType a -> Bool
< :: PoolType a -> PoolType a -> Bool
$c<= :: forall a. Ord a => PoolType a -> PoolType a -> Bool
<= :: PoolType a -> PoolType a -> Bool
$c> :: forall a. Ord a => PoolType a -> PoolType a -> Bool
> :: PoolType a -> PoolType a -> Bool
$c>= :: forall a. Ord a => PoolType a -> PoolType a -> Bool
>= :: PoolType a -> PoolType a -> Bool
$cmax :: forall a. Ord a => PoolType a -> PoolType a -> PoolType a
max :: PoolType a -> PoolType a -> PoolType a
$cmin :: forall a. Ord a => PoolType a -> PoolType a -> PoolType a
min :: PoolType a -> PoolType a -> PoolType a
Ord, Int -> PoolType a -> ShowS
[PoolType a] -> ShowS
PoolType a -> String
(Int -> PoolType a -> ShowS)
-> (PoolType a -> String)
-> ([PoolType a] -> ShowS)
-> Show (PoolType a)
forall a. Show a => Int -> PoolType a -> ShowS
forall a. Show a => [PoolType a] -> ShowS
forall a. Show a => PoolType a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PoolType a -> ShowS
showsPrec :: Int -> PoolType a -> ShowS
$cshow :: forall a. Show a => PoolType a -> String
show :: PoolType a -> String
$cshowList :: forall a. Show a => [PoolType a] -> ShowS
showList :: [PoolType a] -> ShowS
Show)

makePrisms ''PoolType


instance SPV (TestDeal a) where
  getBondsByName :: TestDeal a -> Maybe [String] -> Map String Bond
getBondsByName TestDeal a
t Maybe [String]
bns
    = case Maybe [String]
bns of
        Maybe [String]
Nothing -> TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
t
        Just [String]
_bns -> (String -> Bond -> Bool) -> Map String Bond -> Map String Bond
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\String
k Bond
_ -> String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
k ([String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
_bns)) (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
t)
  
  getActiveBonds :: TestDeal a -> [String] -> [Bond]
getActiveBonds TestDeal a
t [String]
bns = 
    let 
      bnds :: [Bond]
bnds = (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
t Map String Bond -> String -> Bond
forall k a. Ord k => Map k a -> k -> a
Map.!) (String -> Bond) -> [String] -> [Bond]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
bns
    in 
      (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]
bnds

  getBondStmtByName :: TestDeal a -> Maybe [String] -> Map String (Maybe Statement)
getBondStmtByName TestDeal a
t Maybe [String]
bns
    = (Bond -> Maybe Statement)
-> Map String Bond -> Map String (Maybe Statement)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Bond -> Maybe Statement
L.bndStmt Map String Bond
bndsM
      where
      bndsM :: Map String Bond
bndsM = (Bond -> Bond) -> Map String Bond -> Map String Bond
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Bond -> Bond
L.consolStmt (Map String Bond -> Map String Bond)
-> Map String Bond -> Map String Bond
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Maybe [String] -> Map String Bond
forall a. SPV a => a -> Maybe [String] -> Map String Bond
getBondsByName TestDeal a
t Maybe [String]
bns

  getNextBondPayDate :: TestDeal a -> Date
getNextBondPayDate TestDeal a
t
    = case DateDesp
-> DealStatus
-> Either
     String
     (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
      [ActionOnDate])
populateDealDates (TestDeal a -> DateDesp
forall a. TestDeal a -> DateDesp
dates TestDeal a
t) (TestDeal a -> DealStatus
forall a. TestDeal a -> DealStatus
status TestDeal a
t) of
        Right (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
 [ActionOnDate])
_dates -> Getting
  Date
  (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
   [ActionOnDate])
  Date
-> (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
    [ActionOnDate])
-> Date
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  Date
  (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
   [ActionOnDate])
  Date
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
   [ActionOnDate])
  (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
   [ActionOnDate])
  Date
  Date
_3 (Date, Date, Date, [ActionOnDate], [ActionOnDate], Date,
 [ActionOnDate])
_dates 
        Left String
_ -> String -> Date
forall a. HasCallStack => String -> a
error String
"Failed to populate dates"

  getBondBegBal :: TestDeal a -> String -> Amount
getBondBegBal TestDeal a
t String
bn 
    = 
      case Maybe Bond
b of 
        Maybe Bond
Nothing -> Amount
0
        Just Bond
bnd ->
          case Bond -> Maybe Statement
L.bndStmt Bond
bnd of
            Maybe Statement
Nothing -> Bond -> Amount
forall lb. Liable lb => lb -> Amount
L.getCurBalance Bond
bnd  -- `debug` ("Getting beg bal nothing"++bn)
            Just (Statement DList Txn
txns) 
              | DList Txn
forall a. DList a
DL.empty DList Txn -> DList Txn -> Bool
forall a. Eq a => a -> a -> Bool
== DList Txn
txns  -> Bond -> Amount
forall lb. Liable lb => lb -> Amount
L.getCurBalance Bond
bnd  
              | Bool
otherwise -> Txn -> Amount
getTxnBegBalance (Txn -> Amount) -> Txn -> Amount
forall a b. (a -> b) -> a -> b
$ [Txn] -> Txn
forall a. HasCallStack => [a] -> a
head (DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList DList Txn
txns) -- `debug` ("Getting beg bal"++bn++"Last smt"++show (head stmts))
      where
          b :: Maybe Bond
b = (Bond -> Bool) -> [Bond] -> Maybe Bond
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Bond
x -> ((Bond -> String
L.bndName Bond
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bn)) (TestDeal a -> [Bond]
forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
t) 

  getFeeByName :: TestDeal a -> Maybe [String] -> Map String Fee
getFeeByName TestDeal a
t Maybe [String]
fns
    = case Maybe [String]
fns of
         Maybe [String]
Nothing -> TestDeal a -> Map String Fee
forall a. TestDeal a -> Map String Fee
fees TestDeal a
t
         Just [String]
_fns -> (String -> Fee -> Bool) -> Map String Fee -> Map String Fee
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\String
k Fee
_ ->  String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
k ([String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
_fns)) (TestDeal a -> Map String Fee
forall a. TestDeal a -> Map String Fee
fees TestDeal a
t)
  
  getAccountByName :: TestDeal a -> Maybe [String] -> Map String Account
getAccountByName TestDeal a
t Maybe [String]
ans
    = case Maybe [String]
ans of
         Maybe [String]
Nothing -> TestDeal a -> Map String Account
forall a. TestDeal a -> Map String Account
accounts TestDeal a
t
         Just [String]
_ans -> (String -> Account -> Bool)
-> Map String Account -> Map String Account
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\String
k Account
_ ->  String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
k ([String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
_ans)) (TestDeal a -> Map String Account
forall a. TestDeal a -> Map String Account
accounts TestDeal a
t)
  
  isResec :: TestDeal a -> Bool
isResec TestDeal a
t = case TestDeal a -> PoolType a
forall a. TestDeal a -> PoolType a
pool TestDeal a
t of
                 ResecDeal Map PoolId (UnderlyingDeal a)
_ -> Bool
True
                 PoolType a
_ -> Bool
False

  getOustandingBal :: TestDeal a -> Amount
getOustandingBal t :: TestDeal a
t@TestDeal{ bonds :: forall a. TestDeal a -> Map String Bond
bonds = Map String Bond
bndMap, fees :: forall a. TestDeal a -> Map String Fee
fees= Map String Fee
feeMap, liqProvider :: forall a. TestDeal a -> Maybe (Map String LiqFacility)
liqProvider = Maybe (Map String LiqFacility)
mliqMap, rateSwap :: forall a. TestDeal a -> Maybe (Map String RateSwap)
rateSwap = Maybe (Map String RateSwap)
rsMap}
   = let 
      bndBal :: Amount
bndBal = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ Bond -> Amount
forall lb. Liable lb => lb -> Amount
getOutstandingAmount (Bond -> Amount) -> [Bond] -> [Amount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map String Bond
bndMap
      feeBal :: Amount
feeBal = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ Fee -> Amount
forall lb. Liable lb => lb -> Amount
getOutstandingAmount (Fee -> Amount) -> [Fee] -> [Amount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Fee -> [Fee]
forall k a. Map k a -> [a]
Map.elems Map String Fee
feeMap
      lqBalace :: Map k a -> Amount
lqBalace Map k a
m
        | Bool -> Bool
not (Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
m) = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ a -> Amount
forall lb. Liable lb => lb -> Amount
getOutstandingAmount (a -> Amount) -> [a] -> [Amount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k a -> [a]
forall k a. Map k a -> [a]
Map.elems Map k a
m
        | Bool
otherwise = Amount
0
      rsBalance :: Map k a -> Amount
rsBalance Map k a
m
        | Bool -> Bool
not (Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
m) = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ a -> Amount
forall lb. Liable lb => lb -> Amount
getOutstandingAmount (a -> Amount) -> [a] -> [Amount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k a -> [a]
forall k a. Map k a -> [a]
Map.elems Map k a
m
        | Bool
otherwise = Amount
0
     in 
      Amount
bndBal Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
feeBal Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Map String LiqFacility -> Amount
forall {a} {k}. Liable a => Map k a -> Amount
lqBalace (Map String LiqFacility
-> Maybe (Map String LiqFacility) -> Map String LiqFacility
forall a. a -> Maybe a -> a
fromMaybe Map String LiqFacility
forall k a. Map k a
Map.empty Maybe (Map String LiqFacility)
mliqMap) Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Map String RateSwap -> Amount
forall {a} {k}. Liable a => Map k a -> Amount
rsBalance (Map String RateSwap
-> Maybe (Map String RateSwap) -> Map String RateSwap
forall a. a -> Maybe a -> a
fromMaybe Map String RateSwap
forall k a. Map k a
Map.empty Maybe (Map String RateSwap)
rsMap)
  
isPreClosing :: TestDeal a -> Bool
isPreClosing :: forall a. TestDeal a -> Bool
isPreClosing t :: TestDeal a
t@TestDeal{ status :: forall a. TestDeal a -> DealStatus
status = PreClosing DealStatus
_ } = Bool
True
isPreClosing TestDeal a
_ = Bool
False


-- ^ list all bonds and bond groups in list
viewDealAllBonds :: TestDeal a -> [L.Bond]
viewDealAllBonds :: forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
d = 
    let 
       bs :: [Bond]
bs = Map String Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
d)
       view :: Bond -> [Bond]
view a :: Bond
a@(L.Bond {} ) = [Bond
a]
       view a :: Bond
a@(L.BondGroup Map String Bond
bMap Maybe BondType
_) = Map String Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map String Bond
bMap
       view a :: Bond
a@(L.MultiIntBond {}) = [Bond
a]
    in 
       [[Bond]] -> [Bond]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Bond]] -> [Bond]) -> [[Bond]] -> [Bond]
forall a b. (a -> b) -> a -> b
$ Bond -> [Bond]
view (Bond -> [Bond]) -> [Bond] -> [[Bond]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bs

-- ^ flatten all bonds/bond groups in a map
viewBondsInMap :: TestDeal a -> Map.Map String L.Bond
viewBondsInMap :: forall a. TestDeal a -> Map String Bond
viewBondsInMap t :: TestDeal a
t@TestDeal{ bonds :: forall a. TestDeal a -> Map String Bond
bonds = Map String Bond
bndMap }
  = let 
      bnds :: [Bond]
bnds = TestDeal a -> [Bond]
forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
t 
      bndNames :: [String]
bndNames = Bond -> String
L.bndName (Bond -> String) -> [Bond] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bond]
bnds
    in 
      [(String, Bond)] -> Map String Bond
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Bond)] -> Map String Bond)
-> [(String, Bond)] -> Map String Bond
forall a b. (a -> b) -> a -> b
$ [String] -> [Bond] -> [(String, Bond)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
bndNames [Bond]
bnds

-- ^ support bond group
viewDealBondsByNames :: Ast.Asset a => TestDeal a -> [BondName] -> [L.Bond]
viewDealBondsByNames :: forall a. Asset a => TestDeal a -> [String] -> [Bond]
viewDealBondsByNames TestDeal a
_ [] = []
viewDealBondsByNames t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map String Bond
bonds= Map String Bond
bndMap } [String]
bndNames
  = let 
      -- bonds and bond groups
      bnds :: [Bond]
bnds = (Bond -> Bool) -> [Bond] -> [Bond]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Bond
b -> Bond -> String
L.bndName Bond
b String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
bndNames) ([Bond] -> [Bond]) -> [Bond] -> [Bond]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> [Bond]
forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
t
      -- bndsFromGrp = $ Map.filter (\L.BondGroup {} -> True)  bndMap
      bndsFromGrp :: [Bond]
bndsFromGrp = (String -> Bond -> [Bond] -> [Bond])
-> [Bond] -> Map String Bond -> [Bond]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
                      (\String
k (L.BondGroup Map String Bond
bMap Maybe BondType
_) [Bond]
acc -> 
                        if String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
bndNames 
                        then 
                          [Bond]
acc [Bond] -> [Bond] -> [Bond]
forall a. [a] -> [a] -> [a]
++ Map String Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map String Bond
bMap
                        else 
                          [Bond]
acc)
                      []
                      (Getting (Map String Bond) (TestDeal a) (Map String Bond)
-> TestDeal a -> Map String Bond
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map String Bond) (TestDeal a) (Map String Bond)
forall a. Asset a => Lens' (TestDeal a) (Map String Bond)
Lens' (TestDeal a) (Map String Bond)
dealBondGroups TestDeal a
t )
    in 
      [Bond]
bnds [Bond] -> [Bond] -> [Bond]
forall a. [a] -> [a] -> [a]
++ [Bond]
bndsFromGrp

-- ^ find bonds with first match
findBondByNames :: Map.Map String L.Bond -> [BondName] -> Either String [L.Bond]
findBondByNames :: Map String Bond -> [String] -> Either String [Bond]
findBondByNames Map String Bond
bMap [String]
bNames
  = let 
      (Map String Bond
firstMatch, Map String Bond
notMatched) = (String -> Bond -> Bool)
-> Map String Bond -> (Map String Bond, Map String Bond)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\String
k Bond
_ -> String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
bNames) Map String Bond
bMap
      [String]
remainNames::[String] = [String]
bNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ Map String Bond -> [String]
forall k a. Map k a -> [k]
Map.keys Map String Bond
firstMatch
      [Map String Bond]
listOfBondGrps::[Map.Map String L.Bond] = [ Map String Bond
bM |  (Map String Bond
bM,Maybe BondType
_) <-[Maybe (Map String Bond, Maybe BondType)]
-> [(Map String Bond, Maybe BondType)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Map String Bond, Maybe BondType)]
 -> [(Map String Bond, Maybe BondType)])
-> [Maybe (Map String Bond, Maybe BondType)]
-> [(Map String Bond, Maybe BondType)]
forall a b. (a -> b) -> a -> b
$ (Getting
  (First (Map String Bond, Maybe BondType))
  Bond
  (Map String Bond, Maybe BondType)
-> Bond -> Maybe (Map String Bond, Maybe BondType)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First (Map String Bond, Maybe BondType))
  Bond
  (Map String Bond, Maybe BondType)
Prism' Bond (Map String Bond, Maybe BondType)
L._BondGroup) (Bond -> Maybe (Map String Bond, Maybe BondType))
-> [Bond] -> [Maybe (Map String Bond, Maybe BondType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map String Bond
notMatched ]
      (Map String Bond
secondMatch, Map String Bond
notMatched2) = (String -> Bond -> Bool)
-> Map String Bond -> (Map String Bond, Map String Bond)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\String
k Bond
_ -> String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
remainNames) (Map String Bond -> (Map String Bond, Map String Bond))
-> Map String Bond -> (Map String Bond, Map String Bond)
forall a b. (a -> b) -> a -> b
$ [Map String Bond] -> Map String Bond
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map String Bond]
listOfBondGrps
    in 
      if Map String Bond -> Bool
forall k a. Map k a -> Bool
Map.null Map String Bond
notMatched2 then 
        [Bond] -> Either String [Bond]
forall a b. b -> Either a b
Right ([Bond] -> Either String [Bond]) -> [Bond] -> Either String [Bond]
forall a b. (a -> b) -> a -> b
$ Map String Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map String Bond
firstMatch [Bond] -> [Bond] -> [Bond]
forall a. [a] -> [a] -> [a]
++ Map String Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map String Bond
secondMatch
      else
        String -> Either String [Bond]
forall a b. a -> Either a b
Left (String -> Either String [Bond]) -> String -> Either String [Bond]
forall a b. (a -> b) -> a -> b
$ String
"Failed to find bonds by names:"String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (Map String Bond -> [String]
forall k a. Map k a -> [k]
Map.keys Map String Bond
notMatched2)

-- ^ not support bond group
dealBonds :: Ast.Asset a => Lens' (TestDeal a) (Map.Map BondName L.Bond)
dealBonds :: forall a. Asset a => Lens' (TestDeal a) (Map String Bond)
dealBonds = (TestDeal a -> Map String Bond)
-> (TestDeal a -> Map String Bond -> TestDeal a)
-> Lens
     (TestDeal a) (TestDeal a) (Map String Bond) (Map String Bond)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
getter TestDeal a -> Map String Bond -> TestDeal a
forall {a}. TestDeal a -> Map String Bond -> TestDeal a
setter 
  where 
    getter :: TestDeal a -> Map String Bond
getter TestDeal a
d = TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
d 
    setter :: TestDeal a -> Map String Bond -> TestDeal a
setter TestDeal a
d Map String Bond
newBndMap = TestDeal a
d {bonds = newBndMap}

-- ^ get & set bond group only
dealBondGroups :: Ast.Asset a => Lens' (TestDeal a) (Map.Map BondName L.Bond)
dealBondGroups :: forall a. Asset a => Lens' (TestDeal a) (Map String Bond)
dealBondGroups = (TestDeal a -> Map String Bond)
-> (TestDeal a -> Map String Bond -> TestDeal a)
-> Lens
     (TestDeal a) (TestDeal a) (Map String Bond) (Map String Bond)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
getter TestDeal a -> Map String Bond -> TestDeal a
forall {a}. TestDeal a -> Map String Bond -> TestDeal a
setter 
  where 
    getter :: TestDeal a -> Map String Bond
getter TestDeal a
d = (Bond -> Bool) -> Map String Bond -> Map String Bond
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Getting Any Bond (Map String Bond, Maybe BondType) -> Bond -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any Bond (Map String Bond, Maybe BondType)
Prism' Bond (Map String Bond, Maybe BondType)
L._BondGroup) (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
d)
    setter :: TestDeal a -> Map String Bond -> TestDeal a
setter TestDeal a
d Map String Bond
newBndMap = TestDeal a
d {bonds = Map.filter (has L._BondGroup) newBndMap}

bondGroupsBonds :: Lens' L.Bond (Map.Map BondName L.Bond)
bondGroupsBonds :: Lens' Bond (Map String Bond)
bondGroupsBonds = (Bond -> Map String Bond)
-> (Bond -> Map String Bond -> Bond)
-> Lens' Bond (Map String Bond)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Bond -> Map String Bond
getter Bond -> Map String Bond -> Bond
setter 
  where 
    getter :: Bond -> Map String Bond
getter (L.BondGroup Map String Bond
bMap Maybe BondType
_) = Map String Bond
bMap
    getter Bond
_ = Map String Bond
forall k a. Map k a
Map.empty
    setter :: Bond -> Map String Bond -> Bond
setter (L.BondGroup Map String Bond
b Maybe BondType
x) Map String Bond
newBMap = Map String Bond -> Maybe BondType -> Bond
L.BondGroup Map String Bond
newBMap Maybe BondType
x
    setter Bond
x Map String Bond
_ = Bond
x

updateBondInMap :: BondName -> (L.Bond -> L.Bond) -> Map.Map BondName L.Bond ->  Map.Map BondName L.Bond
updateBondInMap :: String -> (Bond -> Bond) -> Map String Bond -> Map String Bond
updateBondInMap String
bName Bond -> Bond
f Map String Bond
bMap 
  = let 
      fn :: String -> Bond -> Bond
fn String
_bName (L.BondGroup Map String Bond
subMap Maybe BondType
bt) = Map String Bond -> Maybe BondType -> Bond
L.BondGroup ((Bond -> Bond) -> String -> Map String Bond -> Map String Bond
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Bond -> Bond
f String
_bName Map String Bond
subMap) Maybe BondType
bt
      fn String
_bName Bond
bnd 
        | String
_bName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bName = Bond -> Bond
f Bond
bnd
        | Bool
otherwise = Bond
bnd
    in 
      (String -> Bond -> Bond) -> Map String Bond -> Map String Bond
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey String -> Bond -> Bond
fn Map String Bond
bMap

dealAccounts :: Ast.Asset a => Lens' (TestDeal a) (Map.Map AccountName A.Account) 
dealAccounts :: forall a. Asset a => Lens' (TestDeal a) (Map String Account)
dealAccounts = (TestDeal a -> Map String Account)
-> (TestDeal a -> Map String Account -> TestDeal a)
-> Lens
     (TestDeal a) (TestDeal a) (Map String Account) (Map String Account)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestDeal a -> Map String Account
forall a. TestDeal a -> Map String Account
getter TestDeal a -> Map String Account -> TestDeal a
forall {a}. TestDeal a -> Map String Account -> TestDeal a
setter 
  where 
    getter :: TestDeal a -> Map String Account
getter TestDeal a
d = TestDeal a -> Map String Account
forall a. TestDeal a -> Map String Account
accounts TestDeal a
d 
    setter :: TestDeal a -> Map String Account -> TestDeal a
setter TestDeal a
d Map String Account
newAccMap = TestDeal a
d {accounts = newAccMap}

dealFees :: Ast.Asset a => Lens' (TestDeal a) (Map.Map FeeName F.Fee) 
dealFees :: forall a. Asset a => Lens' (TestDeal a) (Map String Fee)
dealFees = (TestDeal a -> Map String Fee)
-> (TestDeal a -> Map String Fee -> TestDeal a)
-> Lens (TestDeal a) (TestDeal a) (Map String Fee) (Map String Fee)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestDeal a -> Map String Fee
forall a. TestDeal a -> Map String Fee
getter TestDeal a -> Map String Fee -> TestDeal a
forall {a}. TestDeal a -> Map String Fee -> TestDeal a
setter 
  where 
    getter :: TestDeal a -> Map String Fee
getter TestDeal a
d = TestDeal a -> Map String Fee
forall a. TestDeal a -> Map String Fee
fees TestDeal a
d 
    setter :: TestDeal a -> Map String Fee -> TestDeal a
setter TestDeal a
d Map String Fee
newFeeMap = TestDeal a
d {fees = newFeeMap}

dealPool :: Ast.Asset a => Lens' (TestDeal a) (PoolType a)
dealPool :: forall a. Asset a => Lens' (TestDeal a) (PoolType a)
dealPool = (TestDeal a -> PoolType a)
-> (TestDeal a -> PoolType a -> TestDeal a)
-> Lens (TestDeal a) (TestDeal a) (PoolType a) (PoolType a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestDeal a -> PoolType a
forall a. TestDeal a -> PoolType a
getter TestDeal a -> PoolType a -> TestDeal a
forall {a} {a}. TestDeal a -> PoolType a -> TestDeal a
setter 
  where 
    getter :: TestDeal a -> PoolType a
getter TestDeal a
d = TestDeal a -> PoolType a
forall a. TestDeal a -> PoolType a
pool TestDeal a
d
    setter :: TestDeal a -> PoolType a -> TestDeal a
setter TestDeal a
d PoolType a
newPool = TestDeal a
d {pool = newPool}

poolTypePool :: Ast.Asset a => Lens' (PoolType a) (Map.Map PoolId (P.Pool a))
poolTypePool :: forall a. Asset a => Lens' (PoolType a) (Map PoolId (Pool a))
poolTypePool = (PoolType a -> Map PoolId (Pool a))
-> (PoolType a -> Map PoolId (Pool a) -> PoolType a)
-> Lens
     (PoolType a)
     (PoolType a)
     (Map PoolId (Pool a))
     (Map PoolId (Pool a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolType a -> Map PoolId (Pool a)
forall {a}. PoolType a -> Map PoolId (Pool a)
getter PoolType a -> Map PoolId (Pool a) -> PoolType a
forall {a} {a}. PoolType a -> Map PoolId (Pool a) -> PoolType a
setter
  where
    getter :: PoolType a -> Map PoolId (Pool a)
getter = \case MultiPool Map PoolId (Pool a)
pm -> Map PoolId (Pool a)
pm
    setter :: PoolType a -> Map PoolId (Pool a) -> PoolType a
setter (MultiPool Map PoolId (Pool a)
pm) Map PoolId (Pool a)
newPm = Map PoolId (Pool a) -> PoolType a
forall a. Map PoolId (Pool a) -> PoolType a
MultiPool Map PoolId (Pool a)
newPm

poolTypeUnderDeal :: Ast.Asset a => Lens' (PoolType a) (Map.Map PoolId (UnderlyingDeal a))
poolTypeUnderDeal :: forall a.
Asset a =>
Lens' (PoolType a) (Map PoolId (UnderlyingDeal a))
poolTypeUnderDeal = (PoolType a -> Map PoolId (UnderlyingDeal a))
-> (PoolType a -> Map PoolId (UnderlyingDeal a) -> PoolType a)
-> Lens
     (PoolType a)
     (PoolType a)
     (Map PoolId (UnderlyingDeal a))
     (Map PoolId (UnderlyingDeal a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolType a -> Map PoolId (UnderlyingDeal a)
forall {a}. PoolType a -> Map PoolId (UnderlyingDeal a)
getter PoolType a -> Map PoolId (UnderlyingDeal a) -> PoolType a
forall {a} {a}.
PoolType a -> Map PoolId (UnderlyingDeal a) -> PoolType a
setter
  where 
    getter :: PoolType a -> Map PoolId (UnderlyingDeal a)
getter = \case ResecDeal Map PoolId (UnderlyingDeal a)
dm -> Map PoolId (UnderlyingDeal a)
dm
    setter :: PoolType a -> Map PoolId (UnderlyingDeal a) -> PoolType a
setter (ResecDeal Map PoolId (UnderlyingDeal a)
dm) Map PoolId (UnderlyingDeal a)
newDm = Map PoolId (UnderlyingDeal a) -> PoolType a
forall a. Map PoolId (UnderlyingDeal a) -> PoolType a
ResecDeal Map PoolId (UnderlyingDeal a)
newDm

-- schedulePoolFlowLens = poolTypePool . mapped . P.futureScheduleCfLens 
-- schedulePoolFlowAggLens = schedulePoolFlowLens . _1 . _1
-- scheduleBondFlowLens = poolTypeUnderDeal . mapped . uDealFutureScheduleCf


-- dealInputCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId CF.PoolCashflow)
-- dealInputCashflow = lens getter setter
--   where
--     getter d = case pool d of
--                 MultiPool pm -> Map.map (P.futureScheduleCf) pm
--                 ResecDeal uds -> Map.map futureScheduleCf uds
--     setter d newCfMap = case pool d of
--                           MultiPool pm -> 
-- 			    let 
--                               newPm = Map.mapWithKey (\k p -> set (P.poolFutureScheduleCf) (newCfMap Map.! k) p) pm
--                             in
--                               set dealPool (MultiPool newPm) d
--                           ResecDeal pm -> 
--                             let 
--                               newPm = Map.mapWithKey (\k ud ->gset uDealFutureScheduleCf (newCfMap Map.! k) ud) pm
--                             in
--                               set dealPool (ResecDeal newPm) d

-- dealCashflow :: Ast.Asset a => Lens' (TestDeal a) (Map.Map PoolId (Maybe CF.CashFlowFrame))
-- dealCashflow = lens getter setter
--   where 
--     getter d = case pool d of
--                 MultiPool pm -> Map.map P.futureCf pm
--                 ResecDeal uds -> Map.map futureCf uds
--     setter d newCfMap = case pool d of 
--                           MultiPool pm -> let 
--                                             newPm = Map.mapWithKey (\k p -> set P.poolFutureCf (newCfMap Map.! k) p) pm
--                                           in 
--                                             set dealPool (MultiPool newPm) d
--                           ResecDeal pm ->
--                             let 
--                               newPm = Map.mapWithKey 
-- 			                (\k ud -> set uDealFutureCf (newCfMap Map.! k) ud)
-- 					pm
--                             in
--                               set dealPool (ResecDeal newPm) d

getPoolIds :: Ast.Asset a => TestDeal a -> [PoolId]
getPoolIds :: forall a. Asset a => TestDeal a -> [PoolId]
getPoolIds t :: TestDeal a
t@TestDeal{pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pt} 
  = case PoolType a
pt of
      MultiPool Map PoolId (Pool a)
pm -> Map PoolId (Pool a) -> [PoolId]
forall k a. Map k a -> [k]
Map.keys Map PoolId (Pool a)
pm
      ResecDeal Map PoolId (UnderlyingDeal a)
pm -> Map PoolId (UnderlyingDeal a) -> [PoolId]
forall k a. Map k a -> [k]
Map.keys Map PoolId (UnderlyingDeal a)
pm
      PoolType a
_ -> String -> [PoolId]
forall a. HasCallStack => String -> a
error String
"failed to match pool type in pool ids"

-- ^ to handle with bond group, with flag to good deep if it is a bond group
getBondByName :: Ast.Asset a => TestDeal a -> Bool -> BondName -> Maybe L.Bond
getBondByName :: forall a. Asset a => TestDeal a -> Bool -> String -> Maybe Bond
getBondByName TestDeal a
t Bool
False String
bName = String -> Map String Bond -> Maybe Bond
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
bName (TestDeal a -> Map String Bond
forall a. TestDeal a -> Map String Bond
bonds TestDeal a
t)
getBondByName TestDeal a
t Bool
True String
bName = 
  let 
    bnds :: [Bond]
bnds = TestDeal a -> [Bond]
forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
t
  in 
    (Bond -> Bool) -> [Bond] -> Maybe Bond
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Bond
b -> Bond -> String
L.bndName Bond
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bName) [Bond]
bnds

-- ^ get issuance pool stat from pool map
getIssuanceStats :: Ast.Asset a => TestDeal a  -> Maybe [PoolId] -> Map.Map PoolId (Map.Map CutoffFields Balance)
getIssuanceStats :: forall a.
Asset a =>
TestDeal a
-> Maybe [PoolId] -> Map PoolId (Map CutoffFields Amount)
getIssuanceStats t :: TestDeal a
t@TestDeal{pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pt} Maybe [PoolId]
mPoolId
  = case PoolType a
pt of
      ResecDeal Map PoolId (UnderlyingDeal a)
uDeals -> 
        let 
          selecteduDeals :: Map PoolId (UnderlyingDeal a)
selecteduDeals = case Maybe [PoolId]
mPoolId of 
                            Maybe [PoolId]
Nothing -> Map PoolId (UnderlyingDeal a)
uDeals
                            Just [PoolId]
pns -> (PoolId -> UnderlyingDeal a -> Bool)
-> Map PoolId (UnderlyingDeal a) -> Map PoolId (UnderlyingDeal a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PoolId
k UnderlyingDeal a
_ -> PoolId
k PoolId -> [PoolId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PoolId]
pns ) Map PoolId (UnderlyingDeal a)
uDeals
        in
          (UnderlyingDeal a -> Map CutoffFields Amount)
-> Map PoolId (UnderlyingDeal a)
-> Map PoolId (Map CutoffFields Amount)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Map CutoffFields Amount
-> Maybe (Map CutoffFields Amount) -> Map CutoffFields Amount
forall a. a -> Maybe a -> a
fromMaybe Map CutoffFields Amount
forall k a. Map k a
Map.empty (Maybe (Map CutoffFields Amount) -> Map CutoffFields Amount)
-> (UnderlyingDeal a -> Maybe (Map CutoffFields Amount))
-> UnderlyingDeal a
-> Map CutoffFields Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnderlyingDeal a -> Maybe (Map CutoffFields Amount)
forall a. UnderlyingDeal a -> Maybe (Map CutoffFields Amount)
issuanceStat) Map PoolId (UnderlyingDeal a)
selecteduDeals 
      MultiPool Map PoolId (Pool a)
pm -> let 
                        selectedPools :: Map PoolId (Pool a)
selectedPools = case Maybe [PoolId]
mPoolId of 
                                          Maybe [PoolId]
Nothing -> Map PoolId (Pool a)
pm
                                          Just [PoolId]
pns -> (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
_ -> PoolId
k PoolId -> [PoolId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PoolId]
pns ) Map PoolId (Pool a)
pm
                      in
                        (Pool a -> Map CutoffFields Amount)
-> Map PoolId (Pool a) -> Map PoolId (Map CutoffFields Amount)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Map CutoffFields Amount
-> Maybe (Map CutoffFields Amount) -> Map CutoffFields Amount
forall a. a -> Maybe a -> a
fromMaybe Map CutoffFields Amount
forall k a. Map k a
Map.empty (Maybe (Map CutoffFields Amount) -> Map CutoffFields Amount)
-> (Pool a -> Maybe (Map CutoffFields Amount))
-> Pool a
-> Map CutoffFields Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pool a -> Maybe (Map CutoffFields Amount)
forall a. Pool a -> Maybe (Map CutoffFields Amount)
P.issuanceStat) Map PoolId (Pool a)
selectedPools

getIssuanceStatsConsol :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map CutoffFields Balance
getIssuanceStatsConsol :: forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map CutoffFields Amount
getIssuanceStatsConsol TestDeal a
t Maybe [PoolId]
mPns 
  = let 
      ms :: Map PoolId (Map CutoffFields Amount)
ms = TestDeal a
-> Maybe [PoolId] -> Map PoolId (Map CutoffFields Amount)
forall a.
Asset a =>
TestDeal a
-> Maybe [PoolId] -> Map PoolId (Map CutoffFields Amount)
getIssuanceStats TestDeal a
t Maybe [PoolId]
mPns
    in 
      (Amount -> Amount -> Amount)
-> [Map CutoffFields Amount] -> Map CutoffFields Amount
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
(+) ([Map CutoffFields Amount] -> Map CutoffFields Amount)
-> [Map CutoffFields Amount] -> Map CutoffFields Amount
forall a b. (a -> b) -> a -> b
$ Map PoolId (Map CutoffFields Amount) -> [Map CutoffFields Amount]
forall k a. Map k a -> [a]
Map.elems Map PoolId (Map CutoffFields Amount)
ms

getAllAsset :: TestDeal a -> Maybe [PoolId] -> Map.Map PoolId [a]
getAllAsset :: forall a. TestDeal a -> Maybe [PoolId] -> Map PoolId [a]
getAllAsset t :: TestDeal a
t@TestDeal{pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pt} Maybe [PoolId]
mPns = 
  let 
    assetMap :: Map PoolId [a]
assetMap = case PoolType a
pt of 
                 MultiPool Map PoolId (Pool a)
pm -> (Pool a -> [a]) -> Map PoolId (Pool a) -> Map PoolId [a]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Pool a -> [a]
forall a. Pool a -> [a]
P.assets Map PoolId (Pool a)
pm
                 ResecDeal Map PoolId (UnderlyingDeal a)
_ -> Map PoolId [a]
forall k a. Map k a
Map.empty
                 -- ResecDeal pm -> Map.mapWithKey (\(UnderlyingBond (bn,hpct,sd), d) -> getAllAsset d Nothing) pm
  in
    case Maybe [PoolId]
mPns of 
      Maybe [PoolId]
Nothing -> Map PoolId [a]
assetMap 
      Just [PoolId]
pns -> (PoolId -> [a] -> Bool) -> Map PoolId [a] -> Map PoolId [a]
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PoolId
k [a]
_ -> PoolId
k PoolId -> [PoolId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PoolId]
pns ) Map PoolId [a]
assetMap
    
getAllAssetList :: Ast.Asset a => TestDeal a -> [a]
getAllAssetList :: forall a. Asset a => TestDeal a -> [a]
getAllAssetList TestDeal a
t = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Map PoolId [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (TestDeal a -> Maybe [PoolId] -> Map PoolId [a]
forall a. TestDeal a -> Maybe [PoolId] -> Map PoolId [a]
getAllAsset TestDeal a
t Maybe [PoolId]
forall a. Maybe a
Nothing)

getAllCollectedFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId CF.CashFlowFrame
getAllCollectedFrame :: forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId CashFlowFrame
getAllCollectedFrame t :: TestDeal a
t@TestDeal{pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
poolType} Maybe [PoolId]
mPid = 
  let 
    mCf :: Map PoolId CashFlowFrame
mCf = case PoolType a
poolType of 
            MultiPool Map PoolId (Pool a)
pm -> (Pool a -> CashFlowFrame)
-> Map PoolId (Pool a) -> Map PoolId CashFlowFrame
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Getting CashFlowFrame (Pool a) CashFlowFrame
-> Pool a -> CashFlowFrame
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
-> Pool a -> Const CashFlowFrame (Pool a)
forall a. Asset a => Lens' (Pool a) (Maybe PoolCashflow)
Lens' (Pool a) (Maybe PoolCashflow)
P.poolFutureCf ((Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
 -> Pool a -> Const CashFlowFrame (Pool a))
-> ((CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
    -> Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
-> Getting CashFlowFrame (Pool a) CashFlowFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolCashflow -> Const CashFlowFrame PoolCashflow)
-> Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PoolCashflow -> Const CashFlowFrame PoolCashflow)
 -> Maybe PoolCashflow -> Const CashFlowFrame (Maybe PoolCashflow))
-> ((CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
    -> PoolCashflow -> Const CashFlowFrame PoolCashflow)
-> (CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
-> Maybe PoolCashflow
-> Const CashFlowFrame (Maybe PoolCashflow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CashFlowFrame -> Const CashFlowFrame CashFlowFrame)
-> PoolCashflow -> Const CashFlowFrame PoolCashflow
forall s t a b. Field1 s t a b => Lens s t a b
Lens PoolCashflow PoolCashflow CashFlowFrame CashFlowFrame
_1 )) Map PoolId (Pool a)
pm -- `debug` ("MultiPool" ++ show pm)
            ResecDeal Map PoolId (UnderlyingDeal a)
uds -> (UnderlyingDeal a -> CashFlowFrame)
-> Map PoolId (UnderlyingDeal a) -> Map PoolId CashFlowFrame
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map UnderlyingDeal a -> CashFlowFrame
forall a. UnderlyingDeal a -> CashFlowFrame
futureCf Map PoolId (UnderlyingDeal a)
uds
  in 
    case Maybe [PoolId]
mPid of 
      Maybe [PoolId]
Nothing -> Map PoolId CashFlowFrame
mCf  -- `debug` ("Nothing when collecting cfs"++show mCf)
      Just [PoolId]
pids -> (PoolId -> CashFlowFrame -> Bool)
-> Map PoolId CashFlowFrame -> Map PoolId CashFlowFrame
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PoolId
k CashFlowFrame
_ -> PoolId
k PoolId -> [PoolId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PoolId]
pids) Map PoolId CashFlowFrame
mCf -- `debug` ("Just when collecting cfs"++show mCf)

getLatestCollectFrame :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId (Maybe CF.TsRow)
getLatestCollectFrame :: forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId (Maybe TsRow)
getLatestCollectFrame TestDeal a
t Maybe [PoolId]
mPns = (CashFlowFrame -> Maybe TsRow)
-> Map PoolId CashFlowFrame -> Map PoolId (Maybe TsRow)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\case
                                          (CF.CashFlowFrame (Amount
_,Date
_,Maybe Amount
_) []) -> Maybe TsRow
forall a. Maybe a
Nothing
                                          (CF.CashFlowFrame (Amount
_,Date
_,Maybe Amount
_) [TsRow]
txns) -> TsRow -> Maybe TsRow
forall a. a -> Maybe a
Just (TsRow -> Maybe TsRow) -> TsRow -> Maybe TsRow
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
txns
                                          )
                                        (TestDeal a -> Maybe [PoolId] -> Map PoolId CashFlowFrame
forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId CashFlowFrame
getAllCollectedFrame TestDeal a
t Maybe [PoolId]
mPns)

getAllCollectedTxns :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> Map.Map PoolId [CF.TsRow]
getAllCollectedTxns :: forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId [TsRow]
getAllCollectedTxns TestDeal a
t Maybe [PoolId]
mPns = (CashFlowFrame -> [TsRow])
-> Map PoolId CashFlowFrame -> Map PoolId [TsRow]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (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) (TestDeal a -> Maybe [PoolId] -> Map PoolId CashFlowFrame
forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId CashFlowFrame
getAllCollectedFrame TestDeal a
t Maybe [PoolId]
mPns)

getAllCollectedTxnsList :: Ast.Asset a => TestDeal a -> Maybe [PoolId] -> [CF.TsRow]
getAllCollectedTxnsList :: forall a. Asset a => TestDeal a -> Maybe [PoolId] -> [TsRow]
getAllCollectedTxnsList TestDeal a
t Maybe [PoolId]
mPns 
  = [[TsRow]] -> [TsRow]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TsRow]]
listOfTxns
    where 
      listOfTxns :: [[TsRow]]
listOfTxns = Map PoolId [TsRow] -> [[TsRow]]
forall k a. Map k a -> [a]
Map.elems (Map PoolId [TsRow] -> [[TsRow]])
-> Map PoolId [TsRow] -> [[TsRow]]
forall a b. (a -> b) -> a -> b
$ TestDeal a -> Maybe [PoolId] -> Map PoolId [TsRow]
forall a.
Asset a =>
TestDeal a -> Maybe [PoolId] -> Map PoolId [TsRow]
getAllCollectedTxns TestDeal a
t Maybe [PoolId]
mPns

increasePoolCollectedPeriod :: TestDeal a -> TestDeal a
increasePoolCollectedPeriod :: forall a. TestDeal a -> TestDeal a
increasePoolCollectedPeriod t :: TestDeal a
t@TestDeal{stats :: forall a.
TestDeal a
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
stats = (BalDealStatMap
balMap,RDealStatMap
rateMap,BDealStatMap
boolMap,IDealStatMap
intMap)} 
  = let 
      intMap' :: IDealStatMap
intMap' = (Int -> Int -> Int)
-> DealStatFields -> Int -> IDealStatMap -> IDealStatMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) DealStatFields
PoolCollectedPeriod Int
1 IDealStatMap
intMap
    in 
      TestDeal a
t {stats = (balMap,rateMap,boolMap,intMap')}

increaseBondPaidPeriod :: TestDeal a -> TestDeal a
increaseBondPaidPeriod :: forall a. TestDeal a -> TestDeal a
increaseBondPaidPeriod t :: TestDeal a
t@TestDeal{stats :: forall a.
TestDeal a
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
stats = (BalDealStatMap
balMap,RDealStatMap
rateMap,BDealStatMap
boolMap,IDealStatMap
intMap)} 
  = let 
      intMap' :: IDealStatMap
intMap' = (Int -> Int -> Int)
-> DealStatFields -> Int -> IDealStatMap -> IDealStatMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) DealStatFields
BondPaidPeriod Int
1 IDealStatMap
intMap
    in 
      TestDeal a
t {stats = (balMap,rateMap,boolMap,intMap')}

getDealStatInt :: TestDeal a -> DealStatFields -> Maybe Int
getDealStatInt :: forall a. TestDeal a -> DealStatFields -> Maybe Int
getDealStatInt t :: TestDeal a
t@TestDeal{stats :: forall a.
TestDeal a
-> (BalDealStatMap, RDealStatMap, BDealStatMap, IDealStatMap)
stats = (BalDealStatMap
balMap,RDealStatMap
rateMap,BDealStatMap
boolMap,IDealStatMap
intMap)} DealStatFields
f 
  = DealStatFields -> IDealStatMap -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DealStatFields
f IDealStatMap
intMap

bondTraversal :: Traversal' (TestDeal a) L.Bond
bondTraversal :: forall a (f :: * -> *).
Applicative f =>
(Bond -> f Bond) -> TestDeal a -> f (TestDeal a)
bondTraversal Bond -> f Bond
f t :: TestDeal a
t@TestDeal{bonds :: forall a. TestDeal a -> Map String Bond
bonds = Map String Bond
bndMap} =
  (\Map String Bond
newBndMap -> TestDeal a
t {bonds = newBndMap}) (Map String Bond -> TestDeal a)
-> f (Map String Bond) -> f (TestDeal a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bond -> f Bond) -> Map String Bond -> f (Map String Bond)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map String a -> f (Map String b)
traverse Bond -> f Bond
f Map String Bond
bndMap

data UnderBond b = UnderBond BondName Rate (TestDeal b)

opts :: JSONKeyOptions
opts :: JSONKeyOptions
opts = JSONKeyOptions
defaultJSONKeyOptions

instance ToJSONKey DealStatFields where
  toJSONKey :: ToJSONKeyFunction DealStatFields
toJSONKey = JSONKeyOptions -> ToJSONKeyFunction DealStatFields
forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
opts
instance FromJSONKey DealStatFields where
  fromJSONKey :: FromJSONKeyFunction DealStatFields
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction DealStatFields
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
opts


$(concat <$> traverse (deriveJSON defaultOptions) [''TestDeal, ''UnderlyingDeal, ''PoolType, ''DateDesp, ''ActionOnDate])