DealMod.hs

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

module Deal.DealMod (modDeal, ModifyType(..), AdjStrategy(..)
                     )                      
  where

import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.TH
import Data.Aeson.Encode.Pretty (encodePretty)
import Servant.OpenApi
import Data.OpenApi hiding (Server,contentType,trace)

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 qualified Util as U
import qualified Deal.DealBase as DB
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 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 = flip trace


data AdjStrategy = ScaleBySpread
                 | ScaleByFactor
                 deriving (Show,Generic)

data ModifyType = AddSpreadToBonds BondName
                | SlideBalances BondName BondName
                deriving (Show,Generic)

-- ^ Modify a deal by various type of recipes
modDeal :: Ast.Asset a => ModifyType -> Double -> DB.TestDeal a -> DB.TestDeal a
modDeal (AddSpreadToBonds bnd) sprd d 
  = let 
      sprd' = (fromRational . toRational) sprd
      bndMap = DB.bonds d
      bndMap' = U.mapWithinMap 
                  (\b -> b & L.interestInfoTraversal %~ L.adjInterestInfoBySpread sprd'
                           & L.curRatesTraversal %~ (+ sprd')) 
                  [bnd]
                  bndMap
    in 
      d {DB.bonds = bndMap'}

modDeal (SlideBalances bn1 bn2) r d@DB.TestDeal {DB.bonds = bndMap}
  = let 
      totalBalance = sum $ L.originBalance . L.bndOriginInfo <$> DB.viewDealBondsByNames d [bn1, bn2]
      leftBal = mulBR totalBalance (toRational r) -- `debug` ("split ratio" ++ show r)
      rightBal = totalBalance - leftBal 
      bndMap' = DB.updateBondInMap bn1 (L.adjustBalance leftBal) $
                 DB.updateBondInMap bn2 (L.adjustBalance rightBal) bndMap -- `debug` ("leftBal: " ++ show leftBal ++ ", rightBal: " ++ show rightBal )
    in 
      d {DB.bonds = bndMap'}

modDeal x _ _ = error $ "modify deal: not implemented"++ show x


$(deriveJSON defaultOptions ''AdjStrategy)
instance ToSchema AdjStrategy

$(deriveJSON defaultOptions ''ModifyType)
instance ToSchema ModifyType