{-# 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(..)
  ,getAllTxns,hasEmptyTxn
  )
  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 :: c -> [Char] -> c
debug = ([Char] -> c -> c) -> c -> [Char] -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> c -> c
forall a. [Char] -> a -> a
trace


aggByTxnComment :: [Txn] -> M.Map TxnComment [Txn] -> M.Map TxnComment Balance
aggByTxnComment :: [Txn] -> Map TxnComment [Txn] -> Map TxnComment Interest
aggByTxnComment [] Map TxnComment [Txn]
m = ([Txn] -> Interest)
-> Map TxnComment [Txn] -> Map TxnComment Interest
forall a b k. (a -> b) -> Map k a -> Map k b
M.map [Txn] -> Interest
sumTxn Map TxnComment [Txn]
m 
aggByTxnComment (Txn
txn:[Txn]
txns) Map TxnComment [Txn]
m 
  | TxnComment -> Map TxnComment [Txn] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member TxnComment
c Map TxnComment [Txn]
m = [Txn] -> Map TxnComment [Txn] -> Map TxnComment Interest
aggByTxnComment [Txn]
txns (([Txn] -> [Txn])
-> TxnComment -> Map TxnComment [Txn] -> Map TxnComment [Txn]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ([Txn
txn] [Txn] -> [Txn] -> [Txn]
forall a. [a] -> [a] -> [a]
++) TxnComment
c Map TxnComment [Txn]
m)
  | Bool
otherwise = [Txn] -> Map TxnComment [Txn] -> Map TxnComment Interest
aggByTxnComment [Txn]
txns (TxnComment -> [Txn] -> Map TxnComment [Txn] -> Map TxnComment [Txn]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert TxnComment
c [Txn
txn] Map TxnComment [Txn]
m)
  where 
    c :: TxnComment
c = TxnComment -> TxnComment
normalized (TxnComment -> TxnComment) -> TxnComment -> TxnComment
forall a b. (a -> b) -> a -> b
$ Txn -> TxnComment
getTxnComment Txn
txn
    normalized :: TxnComment -> TxnComment
normalized (FundWith [Char]
bn Interest
_) = [Char] -> Interest -> TxnComment
FundWith [Char]
bn Interest
0
    normalized (PurchaseAsset [Char]
n Interest
_) = [Char] -> Interest -> TxnComment
PurchaseAsset [Char]
n Interest
0
    normalized (TxnComments [TxnComment]
txns) = [TxnComment] -> TxnComment
TxnComments [ TxnComment -> TxnComment
normalized TxnComment
x | TxnComment
x <- [TxnComment]
txns ]
    normalized TxnComment
cmt = TxnComment
cmt

scaleTxn :: Rate -> Txn -> Txn
scaleTxn :: Rate -> Txn -> Txn
scaleTxn Rate
r (BondTxn Date
d Interest
b Interest
i Interest
p IRate
r0 Interest
c Interest
di Interest
dioi Maybe Float
f TxnComment
t) = Date
-> Interest
-> Interest
-> Interest
-> IRate
-> Interest
-> Interest
-> Interest
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
d (Interest -> Rate -> Interest
mulBR Interest
b Rate
r) (Interest -> Rate -> Interest
mulBR Interest
i Rate
r) (Interest -> Rate -> Interest
mulBR Interest
p Rate
r) IRate
r0 (Interest -> Rate -> Interest
mulBR Interest
c Rate
r) (Interest -> Rate -> Interest
mulBR Interest
di Rate
r) (Interest -> Rate -> Interest
mulBR Interest
dioi Rate
r) Maybe Float
f TxnComment
t
scaleTxn Rate
r (AccTxn Date
d Interest
b Interest
a TxnComment
t) = Date -> Interest -> Interest -> TxnComment -> Txn
AccTxn Date
d (Interest -> Rate -> Interest
mulBR Interest
b Rate
r) (Interest -> Rate -> Interest
mulBR Interest
a Rate
r) TxnComment
t
scaleTxn Rate
r (ExpTxn Date
d Interest
b Interest
a Interest
b0 TxnComment
t) = Date -> Interest -> Interest -> Interest -> TxnComment -> Txn
ExpTxn Date
d (Interest -> Rate -> Interest
mulBR Interest
b Rate
r) (Interest -> Rate -> Interest
mulBR Interest
a Rate
r) (Interest -> Rate -> Interest
mulBR Interest
b0 Rate
r) TxnComment
t
scaleTxn Rate
r (SupportTxn Date
d Maybe Interest
b Interest
b0 Interest
i Interest
p Interest
c TxnComment
t) = Date
-> Maybe Interest
-> Interest
-> Interest
-> Interest
-> Interest
-> TxnComment
-> Txn
SupportTxn Date
d ((Interest -> Rate -> Interest) -> Rate -> Interest -> Interest
forall a b c. (a -> b -> c) -> b -> a -> c
flip Interest -> Rate -> Interest
mulBR Rate
r (Interest -> Interest) -> Maybe Interest -> Maybe Interest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Interest
b) (Interest -> Rate -> Interest
mulBR Interest
b0 Rate
r) (Interest -> Rate -> Interest
mulBR Interest
i Rate
r) (Interest -> Rate -> Interest
mulBR Interest
p Rate
r) (Interest -> Rate -> Interest
mulBR Interest
c Rate
r) TxnComment
t
scaleTxn Rate
r (IrsTxn Date
d Interest
b Interest
a IRate
i0 IRate
i1 Interest
b0 TxnComment
t) = Date
-> Interest
-> Interest
-> IRate
-> IRate
-> Interest
-> TxnComment
-> Txn
IrsTxn Date
d (Interest -> Rate -> Interest
mulBR Interest
b Rate
r) (Interest -> Rate -> Interest
mulBR Interest
a Rate
r) IRate
i0 IRate
i1 (Interest -> Rate -> Interest
mulBR Interest
b0 Rate
r) TxnComment
t
scaleTxn Rate
r (EntryTxn Date
d Interest
b Interest
a TxnComment
t) = Date -> Interest -> Interest -> TxnComment -> Txn
EntryTxn Date
d (Interest -> Rate -> Interest
mulBR Interest
b Rate
r)  (Interest -> Rate -> Interest
mulBR Interest
a Rate
r) TxnComment
t

scaleByFactor :: Rate -> [Txn] -> [Txn]
scaleByFactor :: Rate -> [Txn] -> [Txn]
scaleByFactor Rate
r [] = []
scaleByFactor Rate
r [Txn]
txns = (Txn -> Txn) -> [Txn] -> [Txn]
forall a b. (a -> b) -> [a] -> [b]
map (Rate -> Txn -> Txn
scaleTxn Rate
r) [Txn]
txns

sumTxn :: [Txn] -> Balance
sumTxn :: [Txn] -> Interest
sumTxn [Txn]
txns = [Interest] -> Interest
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Interest] -> Interest) -> [Interest] -> Interest
forall a b. (a -> b) -> a -> b
$ Txn -> Interest
getTxnAmt (Txn -> Interest) -> [Txn] -> [Interest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Txn]
txns

getTxnComment :: Txn -> TxnComment
getTxnComment :: Txn -> TxnComment
getTxnComment (BondTxn Date
_ Interest
_ Interest
_ Interest
_ IRate
_ Interest
_ Interest
_ Interest
_ Maybe Float
_ TxnComment
t) = TxnComment
t
getTxnComment (AccTxn Date
_ Interest
_ Interest
_ TxnComment
t ) = TxnComment
t
getTxnComment (ExpTxn Date
_ Interest
_ Interest
_ Interest
_ TxnComment
t ) = TxnComment
t
getTxnComment (SupportTxn Date
_ Maybe Interest
_ Interest
_ Interest
_ Interest
_ Interest
_ TxnComment
t ) = TxnComment
t
getTxnComment (IrsTxn Date
_ Interest
_ Interest
_ IRate
_ IRate
_ Interest
_ TxnComment
t ) = TxnComment
t
getTxnComment (EntryTxn Date
_ Interest
_ Interest
_ TxnComment
t ) = TxnComment
t
getTxnComment (TrgTxn Date
_ Bool
_ TxnComment
t) = TxnComment
t

getTxnBalance :: Txn -> Balance
getTxnBalance :: Txn -> Interest
getTxnBalance (BondTxn Date
_ Interest
t Interest
_ Interest
_ IRate
_ Interest
_ Interest
_ Interest
_ Maybe Float
_ TxnComment
_) = Interest
t
getTxnBalance (AccTxn Date
_ Interest
t Interest
_ TxnComment
_ ) = Interest
t
getTxnBalance (ExpTxn Date
_ Interest
t Interest
_ Interest
_ TxnComment
_ ) = Interest
t
getTxnBalance (SupportTxn Date
_ Maybe Interest
_ Interest
t Interest
_ Interest
_ Interest
_ TxnComment
_ ) = Interest
t -- drawed balance
getTxnBalance (EntryTxn Date
_ Interest
t Interest
_ TxnComment
_) = Interest
t

-- | SupportTxn Date (Maybe Balance) Balance DueInt DuePremium Cash TxnComment    

getTxnBegBalance :: Txn -> Balance
getTxnBegBalance :: Txn -> Interest
getTxnBegBalance (BondTxn Date
_ Interest
t Interest
_ Interest
p IRate
_ Interest
_ Interest
_ Interest
_ Maybe Float
_ TxnComment
_) = Interest
t Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
p
getTxnBegBalance (AccTxn Date
_ Interest
b Interest
a TxnComment
_ ) = Interest
b Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
- Interest
a
getTxnBegBalance (SupportTxn Date
_ Maybe Interest
_ Interest
a Interest
b Interest
_ Interest
_ TxnComment
_) = Interest
b Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
a
getTxnBegBalance (EntryTxn Date
_ Interest
a Interest
b TxnComment
_) = Interest
a Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
b 

getTxnPrincipal :: Txn -> Balance
getTxnPrincipal :: Txn -> Interest
getTxnPrincipal (BondTxn Date
_ Interest
_ Interest
_ Interest
t IRate
_ Interest
_ Interest
_ Interest
_ Maybe Float
_ TxnComment
_) = Interest
t

getTxnAmt :: Txn -> Balance
getTxnAmt :: Txn -> Interest
getTxnAmt (BondTxn Date
_ Interest
_ Interest
_ Interest
_ IRate
_ Interest
t Interest
_ Interest
_ Maybe Float
_ TxnComment
_) = Interest
t
getTxnAmt (AccTxn Date
_ Interest
_ Interest
t TxnComment
_ ) = Interest
t
getTxnAmt (ExpTxn Date
_ Interest
_ Interest
t Interest
_ TxnComment
_ ) = Interest
t
getTxnAmt (SupportTxn Date
_ Maybe Interest
_ Interest
_ Interest
_ Interest
_ Interest
t TxnComment
_) = Interest
t
getTxnAmt (IrsTxn Date
_ Interest
_ Interest
t IRate
_ IRate
_ Interest
_ TxnComment
_ ) = Interest
t
getTxnAmt (EntryTxn Date
_ Interest
_ Interest
t TxnComment
_) = Interest
t
getTxnAmt TrgTxn {} = Interest
0.0

getTxnAsOf :: [Txn] -> Date -> Maybe Txn
getTxnAsOf :: [Txn] -> Date -> Maybe Txn
getTxnAsOf [Txn]
txns Date
d = (Txn -> Bool) -> [Txn] -> Maybe Txn
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Txn
x -> Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate Txn
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
d) ([Txn] -> Maybe Txn) -> [Txn] -> Maybe Txn
forall a b. (a -> b) -> a -> b
$ [Txn] -> [Txn]
forall a. [a] -> [a]
reverse [Txn]
txns

emptyTxn :: Txn -> Date -> Txn
emptyTxn :: Txn -> Date -> Txn
emptyTxn BondTxn {} Date
d = Date
-> Interest
-> Interest
-> Interest
-> IRate
-> Interest
-> Interest
-> Interest
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
d Interest
0 Interest
0 Interest
0 IRate
0 Interest
0 Interest
0 Interest
0 Maybe Float
forall a. Maybe a
Nothing TxnComment
Empty
emptyTxn AccTxn {} Date
d = Date -> Interest -> Interest -> TxnComment -> Txn
AccTxn Date
d Interest
0 Interest
0 TxnComment
Empty
emptyTxn ExpTxn {} Date
d = Date -> Interest -> Interest -> Interest -> TxnComment -> Txn
ExpTxn Date
d Interest
0 Interest
0 Interest
0 TxnComment
Empty
emptyTxn SupportTxn {} Date
d = Date
-> Maybe Interest
-> Interest
-> Interest
-> Interest
-> Interest
-> TxnComment
-> Txn
SupportTxn Date
d Maybe Interest
forall a. Maybe a
Nothing Interest
0 Interest
0 Interest
0 Interest
0 TxnComment
Empty
emptyTxn IrsTxn {} Date
d = Date
-> Interest
-> Interest
-> IRate
-> IRate
-> Interest
-> TxnComment
-> Txn
IrsTxn Date
d Interest
0 Interest
0 IRate
0 IRate
0 Interest
0 TxnComment
Empty
emptyTxn EntryTxn {} Date
d = Date -> Interest -> Interest -> TxnComment -> Txn
EntryTxn Date
d Interest
0 Interest
0 TxnComment
Empty
emptyTxn TrgTxn {} Date
d = Date -> Bool -> TxnComment -> Txn
TrgTxn Date
d Bool
False TxnComment
Empty

isEmptyTxn :: Txn -> Bool
isEmptyTxn :: Txn -> Bool
isEmptyTxn (BondTxn Date
_ Interest
0 Interest
0 Interest
0 IRate
_ Interest
0 Interest
0 Interest
0 Maybe Float
_ TxnComment
Empty) = Bool
True
isEmptyTxn (AccTxn Date
_ Interest
0 Interest
0 TxnComment
Empty) = Bool
True
isEmptyTxn (ExpTxn Date
_ Interest
0 Interest
0 Interest
0 TxnComment
Empty) = Bool
True
isEmptyTxn (SupportTxn Date
_ Maybe Interest
Nothing Interest
0 Interest
0 Interest
0 Interest
0 TxnComment
Empty) = Bool
True
isEmptyTxn (IrsTxn Date
_ Interest
0 Interest
0 IRate
0 IRate
0 Interest
0 TxnComment
Empty) = Bool
True
isEmptyTxn (EntryTxn Date
_ Interest
0 Interest
0 TxnComment
Empty) = Bool
True
isEmptyTxn Txn
_ = Bool
False

viewBalanceAsOf :: Date -> [Txn] -> Balance
viewBalanceAsOf :: Date -> [Txn] -> Interest
viewBalanceAsOf Date
d [] = Interest
0.0 
viewBalanceAsOf Date
d [Txn]
txns 
  | Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
begDate = Txn -> Interest
getTxnBegBalance Txn
fstTxn -- `debug` (" get first txn")
  | Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
endDate = Txn -> Interest
getTxnBalance Txn
lstTxn -- `debug` (" get last txn")
  | Bool
otherwise = Txn -> Interest
getTxnBalance (Txn -> Interest) -> Txn -> Interest
forall a b. (a -> b) -> a -> b
$ Maybe Txn -> Txn
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Txn -> Txn) -> Maybe Txn -> Txn
forall a b. (a -> b) -> a -> b
$ [Txn] -> Date -> Maybe Txn
getTxnAsOf [Txn]
txns Date
d -- `debug` ("Found txn>>>>>"++show d++show (getTxnAsOf txns d))
  where 
    fstTxn :: Txn
fstTxn = [Txn] -> Txn
forall a. HasCallStack => [a] -> a
head [Txn]
txns
    lstTxn :: Txn
lstTxn = [Txn] -> Txn
forall a. HasCallStack => [a] -> a
last [Txn]
txns
    begDate :: Date
begDate = Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate Txn
fstTxn
    endDate :: Date
endDate = Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate Txn
lstTxn

weightAvgBalanceByDates :: [Date] -> [Txn] -> [Balance]
weightAvgBalanceByDates :: [Date] -> [Txn] -> [Interest]
weightAvgBalanceByDates [Date]
ds [Txn]
txns 
  = (\(Date
_sd,Date
_ed) -> Date -> Date -> [Txn] -> Interest
weightAvgBalance Date
_sd Date
_ed [Txn]
txns) ((Date, Date) -> Interest) -> [(Date, Date)] -> [Interest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Date, Date)]
intervals -- `debug` ("interval"++ show intervals++ show txns)
  where 
      intervals :: [(Date, Date)]
intervals = [Date] -> [Date] -> [(Date, Date)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init [Date]
ds) ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
ds) 

-- ^ Txn must be full transactions
weightAvgBalance :: Date -> Date -> [Txn] -> Balance -- txn has to be between sd & ed
weightAvgBalance :: Date -> Date -> [Txn] -> Interest
weightAvgBalance Date
sd Date
ed [Txn]
txns 
  = [Interest] -> Interest
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Interest] -> Interest) -> [Interest] -> Interest
forall a b. (a -> b) -> a -> b
$ (Interest -> Rate -> Interest)
-> [Interest] -> [Rate] -> [Interest]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Interest -> Rate -> Interest
mulBR [Interest]
bals [Rate]
dsFactor -- `debug` ("WavgBalace "++show bals++show dsFactor)
  where 
      _txns :: [Txn]
_txns = RangeType -> Date -> Date -> [Txn] -> [Txn]
forall ts.
TimeSeries ts =>
RangeType -> Date -> Date -> [ts] -> [ts]
sliceBy RangeType
IE Date
sd Date
ed [Txn]
txns
      bals :: [Interest]
bals = (Txn -> Interest) -> [Txn] -> [Interest]
forall a b. (a -> b) -> [a] -> [b]
map Txn -> Interest
getTxnBegBalance [Txn]
_txns [Interest] -> [Interest] -> [Interest]
forall a. [a] -> [a] -> [a]
++ [Txn -> Interest
getTxnBalance ([Txn] -> Txn
forall a. HasCallStack => [a] -> a
last [Txn]
_txns)]
      ds :: [Date]
ds = [Date
sd] [Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++ (Txn -> Date) -> [Txn] -> [Date]
forall a b. (a -> b) -> [a] -> [b]
map Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate [Txn]
_txns [Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++ [Date
ed] 
      dsFactor :: [Rate]
dsFactor = [Date] -> [Rate]
getIntervalFactors [Date]
ds  -- `debug` ("DS>>>"++show ds)

weightAvgBalance' :: Date -> Date -> [Txn] -> Balance 
weightAvgBalance' :: Date -> Date -> [Txn] -> Interest
weightAvgBalance' Date
sd Date
ed [] = Interest
0.0 
weightAvgBalance' Date
sd Date
ed (Txn
_txn:[Txn]
_txns)
  = let 
      -- txns = sliceBy EE sd ed txns
      txns :: [Txn]
txns = [Txn] -> [Txn]
forall a. [a] -> [a]
reverse ([Txn] -> [Txn]) -> [Txn] -> [Txn]
forall a b. (a -> b) -> a -> b
$ ([Txn] -> Txn -> [Txn]) -> [Txn] -> [Txn] -> [Txn]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Txn] -> Txn -> [Txn]
consolTxn [Txn
_txn] [Txn]
_txns
      viewDs :: [Date]
viewDs = [Date] -> [Date]
forall a. Ord a => [a] -> [a]
sort ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ [Date
sd,Date
ed] [Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++ (Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (Txn -> Date) -> [Txn] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RangeType -> Date -> Date -> [Txn] -> [Txn]
forall ts.
TimeSeries ts =>
RangeType -> Date -> Date -> [ts] -> [ts]
sliceBy RangeType
EE  Date
sd Date
ed [Txn]
txns))
      balances :: [Interest]
balances = (Date -> [Txn] -> Interest) -> [Txn] -> Date -> Interest
forall a b c. (a -> b -> c) -> b -> a -> c
flip Date -> [Txn] -> Interest
viewBalanceAsOf [Txn]
txns (Date -> Interest) -> [Date] -> [Interest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date]
viewDs -- `debug` ("get bal snapshot"++ show viewDs++ ">>>"++show txns)
      factors :: [Rate]
factors = [Date] -> [Rate]
getIntervalFactors [Date]
viewDs
    in 
      [Interest] -> Interest
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Interest] -> Interest) -> [Interest] -> Interest
forall a b. (a -> b) -> a -> b
$ (Interest -> Rate -> Interest)
-> [Interest] -> [Rate] -> [Interest]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Interest -> Rate -> Interest
mulBR [Interest]
balances [Rate]
factors --`debug` ("In weight avg bal: Factors"++show factors++"Balances"++show balances ++ "interval "++ show (sd,ed))   

data Statement = Statement (DL.DList Txn)
              deriving (Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> [Char]
(Int -> Statement -> ShowS)
-> (Statement -> [Char])
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Statement -> ShowS
showsPrec :: Int -> Statement -> ShowS
$cshow :: Statement -> [Char]
show :: Statement -> [Char]
$cshowList :: [Statement] -> ShowS
showList :: [Statement] -> ShowS
Show, (forall x. Statement -> Rep Statement x)
-> (forall x. Rep Statement x -> Statement) -> Generic Statement
forall x. Rep Statement x -> Statement
forall x. Statement -> Rep Statement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Statement -> Rep Statement x
from :: forall x. Statement -> Rep Statement x
$cto :: forall x. Rep Statement x -> Statement
to :: forall x. Rep Statement x -> Statement
Generic, Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
/= :: Statement -> Statement -> Bool
Eq, Eq Statement
Eq Statement =>
(Statement -> Statement -> Ordering)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Statement)
-> (Statement -> Statement -> Statement)
-> Ord Statement
Statement -> Statement -> Bool
Statement -> Statement -> Ordering
Statement -> Statement -> Statement
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 :: Statement -> Statement -> Ordering
compare :: Statement -> Statement -> Ordering
$c< :: Statement -> Statement -> Bool
< :: Statement -> Statement -> Bool
$c<= :: Statement -> Statement -> Bool
<= :: Statement -> Statement -> Bool
$c> :: Statement -> Statement -> Bool
> :: Statement -> Statement -> Bool
$c>= :: Statement -> Statement -> Bool
>= :: Statement -> Statement -> Bool
$cmax :: Statement -> Statement -> Statement
max :: Statement -> Statement -> Statement
$cmin :: Statement -> Statement -> Statement
min :: Statement -> Statement -> Statement
Ord, ReadPrec [Statement]
ReadPrec Statement
Int -> ReadS Statement
ReadS [Statement]
(Int -> ReadS Statement)
-> ReadS [Statement]
-> ReadPrec Statement
-> ReadPrec [Statement]
-> Read Statement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Statement
readsPrec :: Int -> ReadS Statement
$creadList :: ReadS [Statement]
readList :: ReadS [Statement]
$creadPrec :: ReadPrec Statement
readPrec :: ReadPrec Statement
$creadListPrec :: ReadPrec [Statement]
readListPrec :: ReadPrec [Statement]
Read)

appendStmt :: Txn -> Maybe Statement -> Maybe Statement
appendStmt :: Txn -> Maybe Statement -> Maybe Statement
appendStmt Txn
txn (Just stmt :: Statement
stmt@(Statement DList Txn
txns)) = Statement -> Maybe Statement
forall a. a -> Maybe a
Just (Statement -> Maybe Statement) -> Statement -> Maybe Statement
forall a b. (a -> b) -> a -> b
$ DList Txn -> Statement
Statement (DList Txn -> Txn -> DList Txn
forall a. DList a -> a -> DList a
DL.snoc DList Txn
txns Txn
txn)
appendStmt Txn
txn Maybe Statement
Nothing = Statement -> Maybe Statement
forall a. a -> Maybe a
Just (Statement -> Maybe Statement) -> Statement -> Maybe Statement
forall a b. (a -> b) -> a -> b
$ DList Txn -> Statement
Statement (DList Txn -> Statement) -> DList Txn -> Statement
forall a b. (a -> b) -> a -> b
$ Txn -> DList Txn
forall a. a -> DList a
DL.singleton Txn
txn




statementTxns :: Lens' Statement (DL.DList Txn)
statementTxns :: Lens' Statement (DList Txn)
statementTxns = (Statement -> DList Txn)
-> (Statement -> DList Txn -> Statement)
-> Lens' Statement (DList Txn)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Statement -> DList Txn
getter Statement -> DList Txn -> Statement
setter
  where 
    getter :: Statement -> DList Txn
getter (Statement DList Txn
txns) = DList Txn
txns
    setter :: Statement -> DList Txn -> Statement
setter (Statement DList Txn
_) DList Txn
txns = DList Txn -> Statement
Statement DList Txn
txns


consolTxn :: [Txn] -> Txn -> [Txn]
consolTxn :: [Txn] -> Txn -> [Txn]
consolTxn [] Txn
txn = [Txn
txn]
consolTxn (Txn
txn:[Txn]
txns) Txn
txn0
  | Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate Txn
txn Date -> Date -> Bool
forall a. Eq a => a -> a -> Bool
== Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate Txn
txn0 = Txn -> Txn -> Txn
combineTxn Txn
txn Txn
txn0Txn -> [Txn] -> [Txn]
forall a. a -> [a] -> [a]
:[Txn]
txns
  | Bool
otherwise = Txn
txn0Txn -> [Txn] -> [Txn]
forall a. a -> [a] -> [a]
:Txn
txnTxn -> [Txn] -> [Txn]
forall a. a -> [a] -> [a]
:[Txn]
txns 

getTxns :: Maybe Statement -> DL.DList Txn
getTxns :: Maybe Statement -> DList Txn
getTxns Maybe Statement
Nothing = DList Txn
forall a. DList a
DL.empty
getTxns (Just (Statement DList Txn
txn)) = DList Txn
txn

combineTxn :: Txn -> Txn -> Txn
combineTxn :: Txn -> Txn -> Txn
combineTxn (BondTxn Date
d1 Interest
b1 Interest
i1 Interest
p1 IRate
r1 Interest
c1 Interest
f1 Interest
g1 Maybe Float
h1 TxnComment
m1) (BondTxn Date
d2 Interest
b2 Interest
i2 Interest
p2 IRate
r2 Interest
c2 Interest
f2 Interest
g2 Maybe Float
h2 TxnComment
m2)
    = let 
        rateToSet :: TxnComment -> TxnComment -> IRate
rateToSet (FundWith [Char]
_ Interest
_) TxnComment
_ = IRate
r2 
        rateToSet TxnComment
_ (FundWith [Char]
_ Interest
_) = IRate
r1 
        rateToSet TxnComment
_ TxnComment
_ = IRate
r2 
      in 
        Date
-> Interest
-> Interest
-> Interest
-> IRate
-> Interest
-> Interest
-> Interest
-> Maybe Float
-> TxnComment
-> Txn
BondTxn Date
d1 Interest
b2 (Interest
i1 Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
i2) (Interest
p1 Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
p2) (TxnComment -> TxnComment -> IRate
rateToSet TxnComment
m1 TxnComment
m2) (Interest
c1Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+Interest
c2) Interest
f2 Interest
g2 Maybe Float
h2 ([TxnComment] -> TxnComment
TxnComments [TxnComment
m1,TxnComment
m2]) 
combineTxn (SupportTxn Date
d1 Maybe Interest
b1 Interest
b0 Interest
i1 Interest
p1 Interest
c1 TxnComment
m1) (SupportTxn Date
d2 Maybe Interest
b2 Interest
b02 Interest
i2 Interest
p2 Interest
c2 TxnComment
m2)
    = Date
-> Maybe Interest
-> Interest
-> Interest
-> Interest
-> Interest
-> TxnComment
-> Txn
SupportTxn Date
d1 Maybe Interest
b2  Interest
b02 (Interest
i1 Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
i2) (Interest
p1 Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
p2) (Interest
c1 Interest -> Interest -> Interest
forall a. Num a => a -> a -> a
+ Interest
c2) ([TxnComment] -> TxnComment
TxnComments [TxnComment
m1,TxnComment
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 (FlowDirection -> FlowDirection -> Bool
(FlowDirection -> FlowDirection -> Bool)
-> (FlowDirection -> FlowDirection -> Bool) -> Eq FlowDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlowDirection -> FlowDirection -> Bool
== :: FlowDirection -> FlowDirection -> Bool
$c/= :: FlowDirection -> FlowDirection -> Bool
/= :: FlowDirection -> FlowDirection -> Bool
Eq,Int -> FlowDirection -> ShowS
[FlowDirection] -> ShowS
FlowDirection -> [Char]
(Int -> FlowDirection -> ShowS)
-> (FlowDirection -> [Char])
-> ([FlowDirection] -> ShowS)
-> Show FlowDirection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlowDirection -> ShowS
showsPrec :: Int -> FlowDirection -> ShowS
$cshow :: FlowDirection -> [Char]
show :: FlowDirection -> [Char]
$cshowList :: [FlowDirection] -> ShowS
showList :: [FlowDirection] -> ShowS
Show,(forall x. FlowDirection -> Rep FlowDirection x)
-> (forall x. Rep FlowDirection x -> FlowDirection)
-> Generic FlowDirection
forall x. Rep FlowDirection x -> FlowDirection
forall x. FlowDirection -> Rep FlowDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FlowDirection -> Rep FlowDirection x
from :: forall x. FlowDirection -> Rep FlowDirection x
$cto :: forall x. Rep FlowDirection x -> FlowDirection
to :: forall x. Rep FlowDirection x -> FlowDirection
Generic)

getFlow :: TxnComment -> FlowDirection
getFlow :: TxnComment -> FlowDirection
getFlow TxnComment
comment =
    case TxnComment
comment of 
      PayInt [[Char]]
_ -> FlowDirection
Outflow
      PayYield [Char]
_ -> FlowDirection
Outflow
      PayPrin [[Char]]
_ -> FlowDirection
Outflow
      PayGroupPrin [[Char]]
_ -> FlowDirection
Outflow
      PayGroupInt [[Char]]
_ -> FlowDirection
Outflow 
      PayPrinResidual [[Char]]
_ -> FlowDirection
Outflow
      PayFee [Char]
_ -> FlowDirection
Outflow
      SeqPayFee [[Char]]
_ -> FlowDirection
Outflow
      PayFeeYield [Char]
_ -> FlowDirection
Outflow
      LiquidationRepay [Char]
_ -> FlowDirection
Outflow
      SwapOutSettle [Char]
_ -> FlowDirection
Outflow
      PurchaseAsset [Char]
_ Interest
_-> FlowDirection
Outflow
      Transfer [Char]
_ [Char]
_ -> FlowDirection
Interflow 
      TransferBy {} -> FlowDirection
Interflow 
      FundWith [Char]
_ Interest
_ -> FlowDirection
Inflow
      PoolInflow Maybe [PoolId]
_ PoolSource
_ -> FlowDirection
Inflow
      LiquidationProceeds [PoolId]
_ -> FlowDirection
Inflow
      LiquidationSupport [Char]
_ -> FlowDirection
Inflow
      TxnComment
BankInt -> FlowDirection
Inflow
      SwapInSettle [Char]
_ -> FlowDirection
Inflow
      IssuanceProceeds [Char]
_ -> FlowDirection
Inflow
      TxnComment
LiquidationDraw -> FlowDirection
Noneflow
      LiquidationSupportInt Interest
_ Interest
_ -> FlowDirection
Noneflow
      WriteOff [Char]
_ Interest
_ -> FlowDirection
Noneflow
      TxnComment
SupportDraw -> FlowDirection
Noneflow
      TxnComment
Empty -> FlowDirection
Noneflow 
      Tag [Char]
_ -> FlowDirection
Noneflow
      UsingDS DealStats
_ -> FlowDirection
Noneflow
      TxnComment
SwapAccrue  -> FlowDirection
Noneflow
      TxnDirection BookDirection
_ -> FlowDirection
Noneflow
      BookLedgerBy BookDirection
_ [Char]
_ -> FlowDirection
Noneflow
      TxnComments [TxnComment]
cmts ->  --TODO the direction of combine txns
        let 
          directionList :: [FlowDirection]
directionList = TxnComment -> FlowDirection
getFlow (TxnComment -> FlowDirection) -> [TxnComment] -> [FlowDirection]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxnComment]
cmts 
        in 
          if FlowDirection
Outflow FlowDirection -> [FlowDirection] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FlowDirection]
directionList then
            FlowDirection
Outflow
          else if (FlowDirection -> Bool) -> [FlowDirection] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FlowDirection
Inflow FlowDirection -> FlowDirection -> Bool
forall a. Eq a => a -> a -> Bool
==) [FlowDirection]
directionList then
            FlowDirection
Inflow
          else
            FlowDirection
Noneflow
      TxnComment
_ -> [Char] -> FlowDirection
forall a. HasCallStack => [Char] -> a
error ([Char]
"Missing in GetFlow >> "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TxnComment -> [Char]
forall a. Show a => a -> [Char]
show TxnComment
comment)

-- ^ filter transaction by apply a filter function on txn comment
filterTxn :: (TxnComment -> Bool) -> [Txn] -> [Txn]
filterTxn :: (TxnComment -> Bool) -> [Txn] -> [Txn]
filterTxn TxnComment -> Bool
f = (Txn -> Bool) -> [Txn] -> [Txn]
forall a. (a -> Bool) -> [a] -> [a]
filter (TxnComment -> Bool
f (TxnComment -> Bool) -> (Txn -> TxnComment) -> Txn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Txn -> TxnComment
getTxnComment)

instance Ord Txn where
  compare :: Txn -> Txn -> Ordering
  compare :: Txn -> Txn -> Ordering
compare (BondTxn Date
d1 Interest
_ Interest
_ Interest
_ IRate
_ Interest
_ Interest
_ Interest
_ Maybe Float
_ TxnComment
_) (BondTxn Date
d2 Interest
_ Interest
_ Interest
_ IRate
_ Interest
_ Interest
_ Interest
_ Maybe Float
_ TxnComment
_) = Date -> Date -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Date
d1 Date
d2
  compare (AccTxn Date
d1 Interest
_ Interest
_ TxnComment
_ ) (AccTxn Date
d2 Interest
_ Interest
_ TxnComment
_  ) = Date -> Date -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Date
d1 Date
d2

instance TimeSeries Txn where 
  getDate :: Txn -> Date
getDate (BondTxn Date
t Interest
_ Interest
_ Interest
_ IRate
_ Interest
_ Interest
_ Interest
_ Maybe Float
_ TxnComment
_ ) = Date
t
  getDate (AccTxn Date
t Interest
_ Interest
_ TxnComment
_ ) = Date
t
  getDate (ExpTxn Date
t Interest
_ Interest
_ Interest
_ TxnComment
_ ) = Date
t
  getDate (SupportTxn Date
t Maybe Interest
_ Interest
_ Interest
_ Interest
_ Interest
_ TxnComment
_) = Date
t
  getDate (IrsTxn Date
t Interest
_ Interest
_ IRate
_ IRate
_ Interest
_ TxnComment
_) = Date
t
  getDate (EntryTxn Date
t Interest
_ Interest
_ TxnComment
_) = Date
t

class QueryByComment a where 
    
    queryStmt :: a -> TxnComment -> [Txn]
    
    queryStmtAsOf :: a -> Date -> TxnComment -> [Txn]
    queryStmtAsOf a
a Date
d TxnComment
tc =  [ Txn
txn | Txn
txn <- a -> TxnComment -> [Txn]
forall a. QueryByComment a => a -> TxnComment -> [Txn]
queryStmt a
a TxnComment
tc, Txn -> Date
forall ts. TimeSeries ts => ts -> Date
getDate Txn
txn Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
d]
    
    queryTxnAmt :: a -> TxnComment -> Balance
    queryTxnAmt a
a TxnComment
tc = [Interest] -> Interest
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Interest] -> Interest) -> [Interest] -> Interest
forall a b. (a -> b) -> a -> b
$ (Txn -> Interest) -> [Txn] -> [Interest]
forall a b. (a -> b) -> [a] -> [b]
map Txn -> Interest
getTxnAmt ([Txn] -> [Interest]) -> [Txn] -> [Interest]
forall a b. (a -> b) -> a -> b
$ a -> TxnComment -> [Txn]
forall a. QueryByComment a => a -> TxnComment -> [Txn]
queryStmt a
a TxnComment
tc
    
    queryTxnAmtAsOf :: a -> Date -> TxnComment -> Balance 
    queryTxnAmtAsOf a
a Date
d TxnComment
tc =  [Interest] -> Interest
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Interest] -> Interest) -> [Interest] -> Interest
forall a b. (a -> b) -> a -> b
$ Txn -> Interest
getTxnAmt (Txn -> Interest) -> [Txn] -> [Interest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Date -> TxnComment -> [Txn]
forall a. QueryByComment a => a -> Date -> TxnComment -> [Txn]
queryStmtAsOf a
a Date
d TxnComment
tc


class HasStmt a where 
  getAllTxns :: a -> [Txn]
  hasEmptyTxn :: a -> Bool

$(deriveJSON defaultOptions ''Statement)