{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

module Expense (Fee(..),FeeType(..),payFee,payResidualFee
               ,buildFeeAccrueAction
               ,feeNameLens,feeDueLens,feeTypeLens,feeStmtLens)
  where

import Lib(Period,paySeqLiabilities,Dates
           ,Amount,Balance,Date,Rate,Ts(..))
import Stmt(appendStmt,Statement,TxnComment(..))
import Data.Traversable
import Language.Haskell.TH

import qualified Data.Text
import           Data.Aeson       hiding (json)
import           Data.Aeson.TH
import           Data.Aeson.Types
import qualified Data.DList as DL
import GHC.Generics

import Data.Fixed
import Types
import Util
import DateUtil
import qualified Stmt as S
import qualified InterestRate as IR

import Control.Lens
import Debug.Trace
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

type FormulaRate = DealStats

data FeeType = AnnualRateFee DealStats FormulaRate                       -- ^ annulized fee with a referece
             | PctFee DealStats FormulaRate                              -- ^ fee base on percentage 
             | FixFee Balance                                            -- ^ one-off fee
             | RecurFee DatePattern Balance                              -- ^ fee occur every date pattern
             | NumFee DatePattern DealStats Amount                       -- ^ fee based on an integer number
             | AmtByTbl DatePattern DealStats (Table Balance Balance)    -- ^ lookup query value in a table
             | TargetBalanceFee DealStats DealStats                      -- ^ fee due amount = max( 0, (ds1 - ds2))
             | FeeFlow Ts                                                -- ^ a time series based fee 
             | FeeFlowByPoolPeriod (PerCurve Balance)                    -- ^ a pool index series based fee
             | FeeFlowByBondPeriod (PerCurve Balance)                    -- ^ a bond index series based fee
             | ByCollectPeriod Amount                                    -- ^ fix amount per collection period
             deriving (Int -> FeeType -> ShowS
[FeeType] -> ShowS
FeeType -> String
(Int -> FeeType -> ShowS)
-> (FeeType -> String) -> ([FeeType] -> ShowS) -> Show FeeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeeType -> ShowS
showsPrec :: Int -> FeeType -> ShowS
$cshow :: FeeType -> String
show :: FeeType -> String
$cshowList :: [FeeType] -> ShowS
showList :: [FeeType] -> ShowS
Show,FeeType -> FeeType -> Bool
(FeeType -> FeeType -> Bool)
-> (FeeType -> FeeType -> Bool) -> Eq FeeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeeType -> FeeType -> Bool
== :: FeeType -> FeeType -> Bool
$c/= :: FeeType -> FeeType -> Bool
/= :: FeeType -> FeeType -> Bool
Eq, (forall x. FeeType -> Rep FeeType x)
-> (forall x. Rep FeeType x -> FeeType) -> Generic FeeType
forall x. Rep FeeType x -> FeeType
forall x. FeeType -> Rep FeeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FeeType -> Rep FeeType x
from :: forall x. FeeType -> Rep FeeType x
$cto :: forall x. Rep FeeType x -> FeeType
to :: forall x. Rep FeeType x -> FeeType
Generic,Eq FeeType
Eq FeeType =>
(FeeType -> FeeType -> Ordering)
-> (FeeType -> FeeType -> Bool)
-> (FeeType -> FeeType -> Bool)
-> (FeeType -> FeeType -> Bool)
-> (FeeType -> FeeType -> Bool)
-> (FeeType -> FeeType -> FeeType)
-> (FeeType -> FeeType -> FeeType)
-> Ord FeeType
FeeType -> FeeType -> Bool
FeeType -> FeeType -> Ordering
FeeType -> FeeType -> FeeType
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 :: FeeType -> FeeType -> Ordering
compare :: FeeType -> FeeType -> Ordering
$c< :: FeeType -> FeeType -> Bool
< :: FeeType -> FeeType -> Bool
$c<= :: FeeType -> FeeType -> Bool
<= :: FeeType -> FeeType -> Bool
$c> :: FeeType -> FeeType -> Bool
> :: FeeType -> FeeType -> Bool
$c>= :: FeeType -> FeeType -> Bool
>= :: FeeType -> FeeType -> Bool
$cmax :: FeeType -> FeeType -> FeeType
max :: FeeType -> FeeType -> FeeType
$cmin :: FeeType -> FeeType -> FeeType
min :: FeeType -> FeeType -> FeeType
Ord)

data Fee = Fee {
  Fee -> String
feeName :: String              -- ^ fee name
  ,Fee -> FeeType
feeType :: FeeType            -- ^ fee type
  ,Fee -> Date
feeStart :: Date              -- ^ when fee become effective
  ,Fee -> Balance
feeDue :: Balance             -- ^ outstanding due amount fee
  ,Fee -> Maybe Date
feeDueDate :: Maybe Date      -- ^ the date when due amount was calculated
  ,Fee -> Balance
feeArrears :: Balance         -- ^ not paid oustanding amout
  ,Fee -> Maybe Date
feeLastPaidDay :: Maybe Date  -- ^ last paid date
  ,Fee -> Maybe Statement
feeStmt :: Maybe Statement    -- ^ transaction history
} deriving (Int -> Fee -> ShowS
[Fee] -> ShowS
Fee -> String
(Int -> Fee -> ShowS)
-> (Fee -> String) -> ([Fee] -> ShowS) -> Show Fee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fee -> ShowS
showsPrec :: Int -> Fee -> ShowS
$cshow :: Fee -> String
show :: Fee -> String
$cshowList :: [Fee] -> ShowS
showList :: [Fee] -> ShowS
Show,Eq Fee
Eq Fee =>
(Fee -> Fee -> Ordering)
-> (Fee -> Fee -> Bool)
-> (Fee -> Fee -> Bool)
-> (Fee -> Fee -> Bool)
-> (Fee -> Fee -> Bool)
-> (Fee -> Fee -> Fee)
-> (Fee -> Fee -> Fee)
-> Ord Fee
Fee -> Fee -> Bool
Fee -> Fee -> Ordering
Fee -> Fee -> Fee
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 :: Fee -> Fee -> Ordering
compare :: Fee -> Fee -> Ordering
$c< :: Fee -> Fee -> Bool
< :: Fee -> Fee -> Bool
$c<= :: Fee -> Fee -> Bool
<= :: Fee -> Fee -> Bool
$c> :: Fee -> Fee -> Bool
> :: Fee -> Fee -> Bool
$c>= :: Fee -> Fee -> Bool
>= :: Fee -> Fee -> Bool
$cmax :: Fee -> Fee -> Fee
max :: Fee -> Fee -> Fee
$cmin :: Fee -> Fee -> Fee
min :: Fee -> Fee -> Fee
Ord, Fee -> Fee -> Bool
(Fee -> Fee -> Bool) -> (Fee -> Fee -> Bool) -> Eq Fee
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fee -> Fee -> Bool
== :: Fee -> Fee -> Bool
$c/= :: Fee -> Fee -> Bool
/= :: Fee -> Fee -> Bool
Eq, (forall x. Fee -> Rep Fee x)
-> (forall x. Rep Fee x -> Fee) -> Generic Fee
forall x. Rep Fee x -> Fee
forall x. Fee -> Rep Fee x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Fee -> Rep Fee x
from :: forall x. Fee -> Rep Fee x
$cto :: forall x. Rep Fee x -> Fee
to :: forall x. Rep Fee x -> Fee
Generic)

payFee :: Date   -- ^ When pay action happen
       -> Amount -- ^ Amount paid to fee
       -> Fee    -- ^ Fee before being paid
       -> Fee    -- ^ Fee after paid
payFee :: Date -> Balance -> Fee -> Fee
payFee Date
d Balance
amt f :: Fee
f@(Fee String
fn FeeType
ft Date
fs Balance
fd Maybe Date
fdDay Balance
fa Maybe Date
flpd Maybe Statement
fstmt) =
   Fee
f {feeLastPaidDay = Just d ,feeDue = dueRemain ,feeArrears = arrearRemain ,feeStmt = newStmt}
   where
    [(Balance
r0,Balance
arrearRemain),(Balance
r1,Balance
dueRemain)] = Balance -> [Balance] -> [(Balance, Balance)]
paySeqLiabilities Balance
amt [Balance
fa,Balance
fd]
    paid :: Balance
paid = Balance
fa Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
fd Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
arrearRemain Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
dueRemain 
    newStmt :: Maybe Statement
newStmt = Txn -> Maybe Statement -> Maybe Statement
appendStmt (Date -> Balance -> Balance -> Balance -> TxnComment -> Txn
ExpTxn Date
d Balance
dueRemain Balance
paid Balance
arrearRemain (String -> TxnComment
PayFee String
fn)) Maybe Statement
fstmt

-- | pay amount of fee regardless the due amount
payResidualFee :: Date -> Amount -> Fee -> Fee
payResidualFee :: Date -> Balance -> Fee -> Fee
payResidualFee Date
d Balance
amt f :: Fee
f@(Fee String
fn FeeType
ft Date
fs Balance
fd Maybe Date
fdDay Balance
fa Maybe Date
flpd Maybe Statement
fstmt) =
   Fee
f {feeLastPaidDay = Just d ,feeDue = dueRemain ,feeArrears = arrearRemain ,feeStmt = newStmt}
   where
    [(Balance
r0,Balance
arrearRemain),(Balance
r1,Balance
dueRemain)] = Balance -> [Balance] -> [(Balance, Balance)]
paySeqLiabilities Balance
amt [Balance
fa,Balance
fd] 
    newStmt :: Maybe Statement
newStmt = Txn -> Maybe Statement -> Maybe Statement
appendStmt (Date -> Balance -> Balance -> Balance -> TxnComment -> Txn
ExpTxn Date
d Balance
dueRemain Balance
amt Balance
arrearRemain (String -> TxnComment
PayFee String
fn)) Maybe Statement
fstmt  

-- | build accure dates for a fee
buildFeeAccrueAction :: [Fee] -> Date -> [(String,Dates)] -> [(String,Dates)]
buildFeeAccrueAction :: [Fee] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildFeeAccrueAction [] Date
ed [(String, Dates)]
r = [(String, Dates)]
r
buildFeeAccrueAction (Fee
fee:[Fee]
fees) Date
ed [(String, Dates)]
r = 
  case Fee
fee of 
    (Fee String
fn (RecurFee DatePattern
dp Balance
_) Date
fs Balance
_ Maybe Date
_ Balance
_ Maybe Date
_ Maybe Statement
_)
      -> [Fee] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildFeeAccrueAction [Fee]
fees Date
ed [(String
fn, DatePattern -> Date -> Date -> Dates
projDatesByPattern DatePattern
dp Date
fs Date
ed)][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r    
    (Fee String
fn (FixFee Balance
_) Date
fs Balance
_ Maybe Date
_ Balance
_ Maybe Date
_ Maybe Statement
_)
      -> [Fee] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildFeeAccrueAction [Fee]
fees Date
ed [(String
fn, [Date
fs])][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r    
    (Fee String
fn (FeeFlow Ts
_ts) Date
_ Balance
_ Maybe Date
_ Balance
_ Maybe Date
_ Maybe Statement
_)
      -> [Fee] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildFeeAccrueAction [Fee]
fees Date
ed [(String
fn, Ts -> Dates
getTsDates Ts
_ts)][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r    
    (Fee String
fn (NumFee DatePattern
dp DealStats
_ Balance
_) Date
fs Balance
_ Maybe Date
_ Balance
_ Maybe Date
_ Maybe Statement
_)
      -> [Fee] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildFeeAccrueAction [Fee]
fees Date
ed [(String
fn, DatePattern -> Date -> Date -> Dates
projDatesByPattern DatePattern
dp Date
fs Date
ed)][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r    
    (Fee String
fn (AmtByTbl DatePattern
dp DealStats
_ Table Balance Balance
_) Date
fs Balance
_ Maybe Date
_ Balance
_ Maybe Date
_ Maybe Statement
_)
      -> [Fee] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildFeeAccrueAction [Fee]
fees Date
ed [(String
fn, DatePattern -> Date -> Date -> Dates
projDatesByPattern DatePattern
dp Date
fs Date
ed)][(String, Dates)] -> [(String, Dates)] -> [(String, Dates)]
forall a. [a] -> [a] -> [a]
++[(String, Dates)]
r    
    Fee
_
      -> [Fee] -> Date -> [(String, Dates)] -> [(String, Dates)]
buildFeeAccrueAction [Fee]
fees Date
ed [(String, Dates)]
r

instance S.QueryByComment Fee where 
    queryStmt :: Fee -> TxnComment -> [Txn]
queryStmt Fee{feeStmt :: Fee -> Maybe Statement
feeStmt = Maybe Statement
Nothing} TxnComment
tc = []
    queryStmt Fee{feeStmt :: Fee -> Maybe Statement
feeStmt = Just (S.Statement DList Txn
txns)} TxnComment
tc
      = (Txn -> Bool) -> [Txn] -> [Txn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Txn
x -> Txn -> TxnComment
S.getTxnComment Txn
x TxnComment -> TxnComment -> Bool
forall a. Eq a => a -> a -> Bool
== TxnComment
tc) (DList Txn -> [Txn]
forall a. DList a -> [a]
DL.toList DList Txn
txns)

instance Liable Fee where 
  isPaidOff :: Fee -> Bool
isPaidOff f :: Fee
f@Fee{feeDue :: Fee -> Balance
feeDue=Balance
bal,feeArrears :: Fee -> Balance
feeArrears=Balance
fa}
    | Balance
balBalance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
==Balance
0 Bool -> Bool -> Bool
&& Balance
faBalance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
==Balance
0 = Bool
True 
    | Bool
otherwise = Bool
False
    
  getOutstandingAmount :: Fee -> Balance
getOutstandingAmount Fee{feeDue :: Fee -> Balance
feeDue=Balance
bal,feeArrears :: Fee -> Balance
feeArrears=Balance
fa} = Balance
bal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
fa

instance IR.UseRate Fee where
  isAdjustbleRate :: Fee -> Bool
isAdjustbleRate Fee
x = Bool
False
  getIndex :: Fee -> Maybe Index
getIndex Fee
x = Maybe Index
forall a. Maybe a
Nothing 

makeLensesFor [("feeName","feeNameLens"),("feeType","feeTypeLens") ,("feeDue","feeDueLens") ,("feeDueDate","feeDueDateLens") ,("feeStmt","feeStmtLens")] ''Fee

$(deriveJSON defaultOptions ''FeeType)
$(deriveJSON defaultOptions ''Fee)