Hastructure-0.45.0: src/Reports.hs

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

module Reports (patchFinancialReports,getItemBalance,buildBalanceSheet,buildCashReport
            ) where

import Data.List ( find, sort )
import qualified Data.DList as DL
import qualified Asset as P
import qualified Data.Map as Map
import qualified Cashflow as CF
import qualified Accounts as A
import qualified CreditEnhancement as CE
import qualified Hedge as HE
import qualified Expense as F
import qualified Liability as L
import Control.Applicative (liftA3)
import Types
import Deal.DealBase
    ( TestDeal(TestDeal, pool, fees, bonds, accounts,liqProvider,rateSwap), getIssuanceStatsConsol, getAllCollectedFrame ,poolTypePool, dealPool)
import Deal.DealQuery ( queryCompound )
import Deal.DealAction ( calcDueFee, calcDueInt )
import Data.Maybe (fromMaybe)

import Control.Lens hiding (element)
import Control.Lens.TH
import Control.Lens
import Stmt
    ( aggByTxnComment,
      getFlow,
      getTxnComment,
      getTxns,
      FlowDirection(Outflow, Inflow) )

-- ^ add financial report to the logs
patchFinancialReports :: P.Asset a => TestDeal a -> Date -> DL.DList ResultComponent -> Either String (DL.DList ResultComponent)
-- patchFinancialReports t d DL.empty = return (DL.empty)
patchFinancialReports t d logs 
  = case (find pickReportLog (reverse (DL.toList logs))) of 
      Nothing -> Right logs
      Just (FinancialReport sd ed bs cash) 
        -> let
             cashReport = buildCashReport t ed d
           in
             do 
               bsReport <- buildBalanceSheet t d
               let newlog = FinancialReport ed d bsReport cashReport
               return (DL.snoc logs newlog)
      where 
        pickReportLog FinancialReport {} = True
        pickReportLog _ = False

getItemBalance :: BookItem -> Balance
getItemBalance (Item _ bal) = bal
getItemBalance (ParentItem _ items) = sum $ getItemBalance <$> items

getPoolBalanceStats :: P.Asset a => TestDeal a -> Date -> Maybe [PoolId] -> Either String [Balance]
getPoolBalanceStats t d mPid 
  = let 
      poolStats = [queryCompound t d (FutureCurrentPoolBalance mPid)
                  ,(queryCompound t d (PoolCumCollection [NewDefaults] mPid))
                  ,negate <$> (queryCompound t d (PoolCumCollection [CollectedRecoveries] mPid))]
    in 
      do 
        poolStats2::[Rational] <- sequenceA poolStats
        return $ fromRational <$> poolStats2





type PoolBalanceSnapshot = (Balance, Balance, Balance)

buildBalanceSheet :: P.Asset a => TestDeal a -> Date -> Either String BalanceSheetReport
buildBalanceSheet t@TestDeal{ pool = pool, bonds = bndMap , fees = feeMap , liqProvider = liqMap, rateSwap = rsMap ,accounts = accMap} 
                  d 
    = let  
        --- accounts
        accM = [ ParentItem accName [Item "Balance" accBal,Item "Accrue Int" accDue] | (accName, [accBal,accDue]) <- Map.toList $ Map.map (\acc -> [A.accBalance,(A.accrueInt d)] <*> [acc]) accMap ]
        -- accsDueMap = [ Item accName accAccrueBal | (accName, accAccrueBal) <- Map.toList $ Map.map (A.accrueInt d) accMap ]
        
        ---- pools
        mapPoolKey PoolConsol = Nothing 
        mapPoolKey (PoolName x) = Just [PoolName x]
        poolAstBalMap_ = Map.mapWithKey 
                           (\k _ -> getPoolBalanceStats t d (mapPoolKey k)) $
                           view (dealPool . poolTypePool) t
        
        ---- swaps
        swapToCollect = ParentItem "Swap" [ ParentItem rsName [ Item "To Receive" rsNet ] | (rsName,rsNet) <- Map.toList (Map.map (HE.rsNetCash . (HE.accrueIRS d)) (fromMaybe Map.empty rsMap))
                                            , rsNet > 0 ]
        
       -- liquidity provider 
        liqProviderAccrued = Map.map (CE.accrueLiqProvider d) (fromMaybe Map.empty liqMap)
        liqProviderOs = [ ParentItem liqName [Item "Balance" liqBal,Item "Accrue Int" liqDueInt, Item "Due Fee" liqDueFee ]  | (liqName,[liqBal,liqDueInt,liqDueFee]) <- Map.toList (Map.map (\liq -> [CE.liqBalance,CE.liqDueInt,CE.liqDuePremium]<*> [liq]) liqProviderAccrued)] 
        -- rate swap
        swapToPay = ParentItem "Swap" [ ParentItem rsName [Item "To Pay" (negate rsNet)] | (rsName,rsNet) <- Map.toList (Map.map (HE.rsNetCash . (HE.accrueIRS d)) (fromMaybe Map.empty rsMap))
                                                   , rsNet < 0 ]

      in
        do
          poolAstBalMap <- sequenceA poolAstBalMap_
          let poolAstMap = Map.mapWithKey 
                             (\k vs -> ParentItem (show k)
                                              [ Item "Performing" (vs!!0) 
                                              , Item "Defaulted"  (vs!!1) 
                                              , Item "Recovery"   (vs!!2) ])
                             poolAstBalMap
          let poolAst = ParentItem "Pool" $ Map.elems poolAstMap
          -- Asset : Account, pool, swap to collect
          let ast = ParentItem "Asset" [ParentItem "Account" accM , poolAst , swapToCollect]
          feeWithDueAmount <- (F.feeDue <$>) <$>  mapM ((calcDueFee t d)) feeMap
          let feeToPay = ParentItem "Fee" [ ParentItem feeName [Item "Due" feeDueBal] 
                                           | (feeName,feeDueBal) <- Map.toList feeWithDueAmount ]
          bndWithDueAmount <- mapM (calcDueInt t d) bndMap
          let bndToShow = Map.map (\bnd -> (L.getCurBalance bnd, L.getTotalDueInt bnd)) bndWithDueAmount 
          let bndM = [ ParentItem bndName [Item "Balance" bndBal,Item "Due Int" bndDueAmt ] 
                                        | (bndName,(bndBal,bndDueAmt)) <- Map.toList bndToShow]
          -- Liabilities: bond, fee, liquidity, swap to pay
          let liab = ParentItem "Liability" [ ParentItem "Bond" bndM , feeToPay, ParentItem "Liquidity" liqProviderOs, swapToPay]
          let totalDebtBal = getItemBalance liab
          let totalAssetBal = getItemBalance ast  
          let eqty = Item "Net Asset" (totalAssetBal - totalDebtBal)
          return $ BalanceSheetReport {asset=ast,liability=liab,equity=eqty,reportDate=d}

-- TODO  performance improve here, need to filter txn first
buildCashReport :: P.Asset a => TestDeal a -> Date -> Date -> CashflowReport
buildCashReport t@TestDeal{accounts = accs} sd ed 
  = CashflowReport { inflow = inflowItems
                   , outflow = outflowItems
                   , net = cashChange
                   , startDate = sd
                   , endDate = ed }
      where 
        _txns = concat $ Map.elems $ Map.map (DL.toList . getTxns) $ Map.map A.accStmt accs
        txns = sliceBy EI sd ed _txns
   
        inflowTxn = sort $ filter (\x -> (getFlow . getTxnComment) x == Inflow)  txns
        outflowTxn = sort $ filter (\x -> (getFlow . getTxnComment) x == Outflow) txns
        
        inflowM = Map.mapKeys show $ aggByTxnComment inflowTxn Map.empty
        outflowM = Map.mapKeys show $ aggByTxnComment outflowTxn Map.empty 
        
        inflowItems = ParentItem "Inflow" [ Item k v | (k,v) <- Map.toList inflowM ]
        outflowItems = ParentItem "Outflow" [ Item k v | (k,v) <- Map.toList outflowM ]
        
        cashChange = Item "Net Cash" $ sum (Map.elems inflowM) + sum (Map.elems outflowM)