{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE InstanceSigs #-}
module Stmt
(Statement(..)
,getTxns,getTxnComment,getTxnAmt,toDate,getTxnPrincipal,getTxnAsOf,getTxnBalance
,appendStmt,combineTxn,getTxnBegBalance,getDate,getDates
,TxnComment(..),QueryByComment(..)
,weightAvgBalanceByDates,weightAvgBalance,weightAvgBalance',sumTxn, consolTxn
,getFlow,FlowDirection(..), aggByTxnComment,scaleByFactor
,scaleTxn,isEmptyTxn, statementTxns, viewBalanceAsOf,filterTxn
,HasStmt(..),Txn(..)
)
where
import Lib (toDate,getIntervalFactors)
import Util (mulBR, mulBInt)
import Types
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Aeson hiding (json)
import Text.Regex.Base
import Text.Regex.PCRE
import Data.Fixed
import Data.List
import qualified Data.DList as DL
import Data.Maybe
import GHC.Generics
import qualified Data.Set as Set
import qualified Data.Vector as V
import qualified Data.Text as T
import qualified Data.Map as M
import Control.Applicative (liftA2)
import Control.Lens hiding (element,Empty)
import Control.Lens.TH
import Debug.Trace
debug = flip trace
aggByTxnComment :: [Txn] -> M.Map TxnComment [Txn] -> M.Map TxnComment Balance
aggByTxnComment [] m = M.map sumTxn m
aggByTxnComment (txn:txns) m
| M.member c m = aggByTxnComment txns (M.adjust ([txn] ++) c m)
| otherwise = aggByTxnComment txns (M.insert c [txn] m)
where
c = normalized $ getTxnComment txn
normalized (FundWith bn _) = FundWith bn 0
normalized (PurchaseAsset n _) = PurchaseAsset n 0
normalized (TxnComments txns) = TxnComments [ normalized x | x <- txns ]
normalized cmt = cmt
scaleTxn :: Rate -> Txn -> Txn
scaleTxn r (BondTxn d b i p r0 c di dioi f t) = BondTxn d (mulBR b r) (mulBR i r) (mulBR p r) r0 (mulBR c r) (mulBR di r) (mulBR dioi r) f t
scaleTxn r (AccTxn d b a t) = AccTxn d (mulBR b r) (mulBR a r) t
scaleTxn r (ExpTxn d b a b0 t) = ExpTxn d (mulBR b r) (mulBR a r) (mulBR b0 r) t
scaleTxn r (SupportTxn d b b0 i p c t) = SupportTxn d (flip mulBR r <$> b) (mulBR b0 r) (mulBR i r) (mulBR p r) (mulBR c r) t
scaleTxn r (IrsTxn d b a i0 i1 b0 t) = IrsTxn d (mulBR b r) (mulBR a r) i0 i1 (mulBR b0 r) t
scaleTxn r (EntryTxn d b a t) = EntryTxn d (mulBR b r) (mulBR a r) t
scaleByFactor :: Rate -> [Txn] -> [Txn]
scaleByFactor r [] = []
scaleByFactor r txns = map (scaleTxn r) txns
sumTxn :: [Txn] -> Balance
sumTxn txns = sum $ getTxnAmt <$> txns
getTxnComment :: Txn -> TxnComment
getTxnComment (BondTxn _ _ _ _ _ _ _ _ _ t) = t
getTxnComment (AccTxn _ _ _ t ) = t
getTxnComment (ExpTxn _ _ _ _ t ) = t
getTxnComment (SupportTxn _ _ _ _ _ _ t ) = t
getTxnComment (IrsTxn _ _ _ _ _ _ t ) = t
getTxnComment (EntryTxn _ _ _ t ) = t
getTxnComment (TrgTxn _ _ t) = t
getTxnBalance :: Txn -> Balance
getTxnBalance (BondTxn _ t _ _ _ _ _ _ _ _) = t
getTxnBalance (AccTxn _ t _ _ ) = t
getTxnBalance (ExpTxn _ t _ _ _ ) = t
getTxnBalance (SupportTxn _ _ t _ _ _ _ ) = t -- drawed balance
getTxnBalance (EntryTxn _ t _ _) = t
-- | SupportTxn Date (Maybe Balance) Balance DueInt DuePremium Cash TxnComment
getTxnBegBalance :: Txn -> Balance
getTxnBegBalance (BondTxn _ t _ p _ _ _ _ _ _) = t + p
getTxnBegBalance (AccTxn _ b a _ ) = b - a
getTxnBegBalance (SupportTxn _ _ a b _ _ _) = b + a
getTxnBegBalance (EntryTxn _ a b _) = a + b
getTxnPrincipal :: Txn -> Balance
getTxnPrincipal (BondTxn _ _ _ t _ _ _ _ _ _) = t
getTxnAmt :: Txn -> Balance
getTxnAmt (BondTxn _ _ _ _ _ t _ _ _ _) = t
getTxnAmt (AccTxn _ _ t _ ) = t
getTxnAmt (ExpTxn _ _ t _ _ ) = t
getTxnAmt (SupportTxn _ _ _ _ _ t _) = t
getTxnAmt (IrsTxn _ _ t _ _ _ _ ) = t
getTxnAmt (EntryTxn _ _ t _) = t
getTxnAmt TrgTxn {} = 0.0
getTxnAsOf :: [Txn] -> Date -> Maybe Txn
getTxnAsOf txns d = find (\x -> getDate x <= d) $ reverse txns
emptyTxn :: Txn -> Date -> Txn
emptyTxn BondTxn {} d = BondTxn d 0 0 0 0 0 0 0 Nothing Empty
emptyTxn AccTxn {} d = AccTxn d 0 0 Empty
emptyTxn ExpTxn {} d = ExpTxn d 0 0 0 Empty
emptyTxn SupportTxn {} d = SupportTxn d Nothing 0 0 0 0 Empty
emptyTxn IrsTxn {} d = IrsTxn d 0 0 0 0 0 Empty
emptyTxn EntryTxn {} d = EntryTxn d 0 0 Empty
emptyTxn TrgTxn {} d = TrgTxn d False Empty
isEmptyTxn :: Txn -> Bool
isEmptyTxn (BondTxn _ 0 0 0 _ 0 0 0 _ Empty) = True
isEmptyTxn (AccTxn _ 0 0 Empty) = True
isEmptyTxn (ExpTxn _ 0 0 0 Empty) = True
isEmptyTxn (SupportTxn _ Nothing 0 0 0 0 Empty) = True
isEmptyTxn (IrsTxn _ 0 0 0 0 0 Empty) = True
isEmptyTxn (EntryTxn _ 0 0 Empty) = True
isEmptyTxn _ = False
viewBalanceAsOf :: Date -> [Txn] -> Balance
viewBalanceAsOf d [] = 0.0
viewBalanceAsOf d txns
| d < begDate = getTxnBegBalance fstTxn -- `debug` (" get first txn")
| d > endDate = getTxnBalance lstTxn -- `debug` (" get last txn")
| otherwise = getTxnBalance $ fromJust $ getTxnAsOf txns d -- `debug` ("Found txn>>>>>"++show d++show (getTxnAsOf txns d))
where
fstTxn = head txns
lstTxn = last txns
begDate = getDate fstTxn
endDate = getDate lstTxn
weightAvgBalanceByDates :: [Date] -> [Txn] -> [Balance]
weightAvgBalanceByDates ds txns
= (\(_sd,_ed) -> weightAvgBalance _sd _ed txns) <$> intervals -- `debug` ("interval"++ show intervals++ show txns)
where
intervals = zip (init ds) (tail ds)
-- ^ Txn must be full transactions
weightAvgBalance :: Date -> Date -> [Txn] -> Balance -- txn has to be between sd & ed
weightAvgBalance sd ed txns
= sum $ zipWith mulBR bals dsFactor -- `debug` ("WavgBalace "++show bals++show dsFactor)
where
_txns = sliceBy IE sd ed txns
bals = map getTxnBegBalance _txns ++ [getTxnBalance (last _txns)]
ds = [sd] ++ map getDate _txns ++ [ed]
dsFactor = getIntervalFactors ds -- `debug` ("DS>>>"++show ds)
weightAvgBalance' :: Date -> Date -> [Txn] -> Balance
weightAvgBalance' sd ed [] = 0.0
weightAvgBalance' sd ed (_txn:_txns)
= let
-- txns = sliceBy EE sd ed txns
txns = reverse $ foldl consolTxn [_txn] _txns
viewDs = sort $ [sd,ed] ++ (getDate <$> (sliceBy EE sd ed txns))
balances = flip viewBalanceAsOf txns <$> viewDs -- `debug` ("get bal snapshot"++ show viewDs++ ">>>"++show txns)
factors = getIntervalFactors viewDs
in
sum $ zipWith mulBR balances factors --`debug` ("In weight avg bal: Factors"++show factors++"Balances"++show balances ++ "interval "++ show (sd,ed))
data Statement = Statement (DL.DList Txn)
deriving (Show, Generic, Eq, Ord, Read)
appendStmt :: Txn -> Maybe Statement -> Maybe Statement
appendStmt txn (Just stmt@(Statement txns)) = Just $ Statement (DL.snoc txns txn)
appendStmt txn Nothing = Just $ Statement $ DL.singleton txn
statementTxns :: Lens' Statement (DL.DList Txn)
statementTxns = lens getter setter
where
getter (Statement txns) = txns
setter (Statement _) txns = Statement txns
consolTxn :: [Txn] -> Txn -> [Txn]
consolTxn [] txn = [txn]
consolTxn (txn:txns) txn0
| getDate txn == getDate txn0 = combineTxn txn txn0:txns
| otherwise = txn0:txn:txns
getTxns :: Maybe Statement -> DL.DList Txn
getTxns Nothing = DL.empty
getTxns (Just (Statement txn)) = txn
combineTxn :: Txn -> Txn -> Txn
combineTxn (BondTxn d1 b1 i1 p1 r1 c1 f1 g1 h1 m1) (BondTxn d2 b2 i2 p2 r2 c2 f2 g2 h2 m2)
= let
rateToSet (FundWith _ _) _ = r2
rateToSet _ (FundWith _ _) = r1
rateToSet _ _ = r2
in
BondTxn d1 b2 (i1 + i2) (p1 + p2) (rateToSet m1 m2) (c1+c2) f2 g2 h2 (TxnComments [m1,m2])
combineTxn (SupportTxn d1 b1 b0 i1 p1 c1 m1) (SupportTxn d2 b2 b02 i2 p2 c2 m2)
= SupportTxn d1 b2 b02 (i1 + i2) (p1 + p2) (c1 + c2) (TxnComments [m1,m2])
data FlowDirection = Inflow -- cash flow into the SPV
| Outflow -- cash flow out of the SPV
| Interflow -- cash flow within the SPV
| Noneflow -- no cash flow
deriving (Eq,Show,Generic)
getFlow :: TxnComment -> FlowDirection
getFlow comment =
case comment of
PayInt _ -> Outflow
PayYield _ -> Outflow
PayPrin _ -> Outflow
PayGroupPrin _ -> Outflow
PayGroupInt _ -> Outflow
PayPrinResidual _ -> Outflow
PayFee _ -> Outflow
SeqPayFee _ -> Outflow
PayFeeYield _ -> Outflow
LiquidationRepay _ -> Outflow
SwapOutSettle _ -> Outflow
PurchaseAsset _ _-> Outflow
Transfer _ _ -> Interflow
TransferBy {} -> Interflow
FundWith _ _ -> Inflow
PoolInflow _ _ -> Inflow
LiquidationProceeds _ -> Inflow
LiquidationSupport _ -> Inflow
BankInt -> Inflow
SwapInSettle _ -> Inflow
IssuanceProceeds _ -> Inflow
LiquidationDraw -> Noneflow
LiquidationSupportInt _ _ -> Noneflow
WriteOff _ _ -> Noneflow
SupportDraw -> Noneflow
Empty -> Noneflow
Tag _ -> Noneflow
UsingDS _ -> Noneflow
SwapAccrue -> Noneflow
TxnDirection _ -> Noneflow
BookLedgerBy _ _ -> Noneflow
TxnComments cmts -> --TODO the direction of combine txns
let
directionList = getFlow <$> cmts
in
if Outflow `elem` directionList then
Outflow
else if any (Inflow ==) directionList then
Inflow
else
Noneflow
_ -> error ("Missing in GetFlow >> "++ show comment)
-- ^ filter transaction by apply a filter function on txn comment
filterTxn :: (TxnComment -> Bool) -> [Txn] -> [Txn]
filterTxn f = filter (f . getTxnComment)
instance Ord Txn where
compare :: Txn -> Txn -> Ordering
compare (BondTxn d1 _ _ _ _ _ _ _ _ _) (BondTxn d2 _ _ _ _ _ _ _ _ _) = compare d1 d2
compare (AccTxn d1 _ _ _ ) (AccTxn d2 _ _ _ ) = compare d1 d2
instance TimeSeries Txn where
getDate (BondTxn t _ _ _ _ _ _ _ _ _ ) = t
getDate (AccTxn t _ _ _ ) = t
getDate (ExpTxn t _ _ _ _ ) = t
getDate (SupportTxn t _ _ _ _ _ _) = t
getDate (IrsTxn t _ _ _ _ _ _) = t
getDate (EntryTxn t _ _ _) = t
class QueryByComment a where
queryStmt :: a -> TxnComment -> [Txn]
queryStmtAsOf :: a -> Date -> TxnComment -> [Txn]
queryStmtAsOf a d tc = [ txn | txn <- queryStmt a tc, getDate txn <= d]
queryTxnAmt :: a -> TxnComment -> Balance
queryTxnAmt a tc = sum $ map getTxnAmt $ queryStmt a tc
queryTxnAmtAsOf :: a -> Date -> TxnComment -> Balance
queryTxnAmtAsOf a d tc = sum $ getTxnAmt <$> queryStmtAsOf a d tc
class HasStmt a where
getAllTxns :: a -> [Txn]
hasEmptyTxn :: a -> Bool
$(deriveJSON defaultOptions ''Statement)