{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Deal.DealCollection
( depositInflow
, depositPoolFlow
, readProceeds
, extractTxnsFromFlowFrameMap
, CollectionRule(..)
) where
import GHC.Generics
import Data.Aeson.TH
import Data.Aeson.Types
import qualified Accounts as A
import qualified Waterfall as W
import qualified Cashflow as CF
import qualified Data.Map as Map hiding (mapEither)
import Data.List
import Control.Monad
import Types
import Util
import Lib
import Control.Lens hiding (element)
data CollectionRule = Collect (Maybe [PoolId]) PoolSource AccountName
| CollectByPct (Maybe [PoolId]) PoolSource [(Rate,AccountName)]
deriving (Int -> CollectionRule -> ShowS
[CollectionRule] -> ShowS
CollectionRule -> String
(Int -> CollectionRule -> ShowS)
-> (CollectionRule -> String)
-> ([CollectionRule] -> ShowS)
-> Show CollectionRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectionRule -> ShowS
showsPrec :: Int -> CollectionRule -> ShowS
$cshow :: CollectionRule -> String
show :: CollectionRule -> String
$cshowList :: [CollectionRule] -> ShowS
showList :: [CollectionRule] -> ShowS
Show,(forall x. CollectionRule -> Rep CollectionRule x)
-> (forall x. Rep CollectionRule x -> CollectionRule)
-> Generic CollectionRule
forall x. Rep CollectionRule x -> CollectionRule
forall x. CollectionRule -> Rep CollectionRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CollectionRule -> Rep CollectionRule x
from :: forall x. CollectionRule -> Rep CollectionRule x
$cto :: forall x. Rep CollectionRule x -> CollectionRule
to :: forall x. Rep CollectionRule x -> CollectionRule
Generic,CollectionRule -> CollectionRule -> Bool
(CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool) -> Eq CollectionRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollectionRule -> CollectionRule -> Bool
== :: CollectionRule -> CollectionRule -> Bool
$c/= :: CollectionRule -> CollectionRule -> Bool
/= :: CollectionRule -> CollectionRule -> Bool
Eq,Eq CollectionRule
Eq CollectionRule =>
(CollectionRule -> CollectionRule -> Ordering)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> CollectionRule)
-> (CollectionRule -> CollectionRule -> CollectionRule)
-> Ord CollectionRule
CollectionRule -> CollectionRule -> Bool
CollectionRule -> CollectionRule -> Ordering
CollectionRule -> CollectionRule -> CollectionRule
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 :: CollectionRule -> CollectionRule -> Ordering
compare :: CollectionRule -> CollectionRule -> Ordering
$c< :: CollectionRule -> CollectionRule -> Bool
< :: CollectionRule -> CollectionRule -> Bool
$c<= :: CollectionRule -> CollectionRule -> Bool
<= :: CollectionRule -> CollectionRule -> Bool
$c> :: CollectionRule -> CollectionRule -> Bool
> :: CollectionRule -> CollectionRule -> Bool
$c>= :: CollectionRule -> CollectionRule -> Bool
>= :: CollectionRule -> CollectionRule -> Bool
$cmax :: CollectionRule -> CollectionRule -> CollectionRule
max :: CollectionRule -> CollectionRule -> CollectionRule
$cmin :: CollectionRule -> CollectionRule -> CollectionRule
min :: CollectionRule -> CollectionRule -> CollectionRule
Ord)
readProceeds :: PoolSource -> CF.TsRow -> Either String Balance
readProceeds :: PoolSource -> TsRow -> Either String Balance
readProceeds PoolSource
CollectedInterest TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowInterest TsRow
x
readProceeds PoolSource
CollectedPrincipal TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowPrincipal TsRow
x
readProceeds PoolSource
CollectedRecoveries TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowRecovery TsRow
x
readProceeds PoolSource
CollectedPrepayment TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowPrepayment TsRow
x
readProceeds PoolSource
CollectedRental TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowRental TsRow
x
readProceeds PoolSource
CollectedPrepaymentPenalty TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowPrepaymentPenalty TsRow
x
readProceeds PoolSource
CollectedCash TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.tsTotalCash TsRow
x
readProceeds PoolSource
CollectedFeePaid TsRow
x = Balance -> Either String Balance
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Balance -> Either String Balance)
-> Balance -> Either String Balance
forall a b. (a -> b) -> a -> b
$ TsRow -> Balance
CF.mflowFeePaid TsRow
x
readProceeds PoolSource
a TsRow
_ = String -> Either String Balance
forall a b. a -> Either a b
Left (String -> Either String Balance)
-> String -> Either String Balance
forall a b. (a -> b) -> a -> b
$ String
" Failed to find pool cashflow field from pool cashflow rule "String -> ShowS
forall a. [a] -> [a] -> [a]
++PoolSource -> String
forall a. Show a => a -> String
show PoolSource
a
extractTxnsFromFlowFrameMap :: Maybe [PoolId] -> Map.Map PoolId CF.PoolCashflow -> [CF.TsRow]
Maybe [PoolId]
mPids Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pflowMap =
let
extractTxns :: Map.Map PoolId CF.PoolCashflow -> [CF.TsRow]
extractTxns :: Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxns Map PoolId (AssetCashflow, Maybe [AssetCashflow])
m = ((AssetCashflow, Maybe [AssetCashflow]) -> [TsRow])
-> [(AssetCashflow, Maybe [AssetCashflow])] -> [TsRow]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Getting [TsRow] (AssetCashflow, Maybe [AssetCashflow]) [TsRow]
-> (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((AssetCashflow -> Const [TsRow] AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
(AssetCashflow, Maybe [AssetCashflow])
(AssetCashflow, Maybe [AssetCashflow])
AssetCashflow
AssetCashflow
_1 ((AssetCashflow -> Const [TsRow] AssetCashflow)
-> (AssetCashflow, Maybe [AssetCashflow])
-> Const [TsRow] (AssetCashflow, Maybe [AssetCashflow]))
-> (([TsRow] -> Const [TsRow] [TsRow])
-> AssetCashflow -> Const [TsRow] AssetCashflow)
-> Getting [TsRow] (AssetCashflow, Maybe [AssetCashflow]) [TsRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TsRow] -> Const [TsRow] [TsRow])
-> AssetCashflow -> Const [TsRow] AssetCashflow
Lens' AssetCashflow [TsRow]
CF.cashflowTxn)) ([(AssetCashflow, Maybe [AssetCashflow])] -> [TsRow])
-> [(AssetCashflow, Maybe [AssetCashflow])] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> [(AssetCashflow, Maybe [AssetCashflow])]
forall k a. Map k a -> [a]
Map.elems Map PoolId (AssetCashflow, Maybe [AssetCashflow])
m
in
case Maybe [PoolId]
mPids of
Maybe [PoolId]
Nothing -> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxns Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pflowMap
Just [PoolId]
pids -> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxns (Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
forall a b. (a -> b) -> a -> b
$ (PoolId -> (AssetCashflow, Maybe [AssetCashflow]) -> Bool)
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PoolId
k (AssetCashflow, Maybe [AssetCashflow])
_ -> PoolId
k PoolId -> [PoolId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PoolId]
pids) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pflowMap
depositInflow :: Date -> CollectionRule -> Map.Map PoolId CF.PoolCashflow -> Map.Map AccountName A.Account -> Either String (Map.Map AccountName A.Account)
depositInflow :: Date
-> CollectionRule
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map String Account
-> Either String (Map String Account)
depositInflow Date
d (Collect Maybe [PoolId]
mPids PoolSource
s String
an) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map String Account
amap
= do
[Balance]
amts <- (TsRow -> Either String Balance)
-> [TsRow] -> Either String [Balance]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (PoolSource -> TsRow -> Either String Balance
readProceeds PoolSource
s) [TsRow]
txns
let amt :: Balance
amt = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
amts
Map String Account -> Either String (Map String Account)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String Account -> Either String (Map String Account))
-> Map String Account -> Either String (Map String Account)
forall a b. (a -> b) -> a -> b
$ (Account -> Account)
-> String -> Map String Account -> Map String Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
amt Date
d (Maybe [PoolId] -> PoolSource -> TxnComment
PoolInflow Maybe [PoolId]
mPids PoolSource
s)) String
an Map String Account
amap
where
txns :: [TsRow]
txns = Maybe [PoolId]
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxnsFromFlowFrameMap Maybe [PoolId]
mPids Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap
depositInflow Date
d (CollectByPct Maybe [PoolId]
mPids PoolSource
s [(Rate, String)]
splitRules) Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map String Account
amap
= do
[Balance]
amts <- (TsRow -> Either String Balance)
-> [TsRow] -> Either String [Balance]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (PoolSource -> TsRow -> Either String Balance
readProceeds PoolSource
s) [TsRow]
txns
let amt :: Balance
amt = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
amts
let amtsToAccs :: [(String, Balance)]
amtsToAccs = [ (String
an, Balance -> Rate -> Balance
mulBR Balance
amt Rate
splitRate) | (Rate
splitRate, String
an) <- [(Rate, String)]
splitRules]
Map String Account -> Either String (Map String Account)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String Account -> Either String (Map String Account))
-> Map String Account -> Either String (Map String Account)
forall a b. (a -> b) -> a -> b
$
((String, Balance) -> Map String Account -> Map String Account)
-> Map String Account -> [(String, Balance)] -> Map String Account
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(String
accName,Balance
accAmt) Map String Account
accM ->
(Account -> Account)
-> String -> Map String Account -> Map String Account
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Balance -> Date -> TxnComment -> Account -> Account
A.deposit Balance
accAmt Date
d (Maybe [PoolId] -> PoolSource -> TxnComment
PoolInflow Maybe [PoolId]
mPids PoolSource
s)) String
accName Map String Account
accM)
Map String Account
amap
[(String, Balance)]
amtsToAccs
where
txns :: [TsRow]
txns = Maybe [PoolId]
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow]) -> [TsRow]
extractTxnsFromFlowFrameMap Maybe [PoolId]
mPids Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap
depositPoolFlow :: [CollectionRule] -> Date -> Map.Map PoolId CF.PoolCashflow -> Map.Map String A.Account -> Either String (Map.Map String A.Account)
depositPoolFlow :: [CollectionRule]
-> Date
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map String Account
-> Either String (Map String Account)
depositPoolFlow [CollectionRule]
rules Date
d Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map String Account
amap
= (Map String Account
-> CollectionRule -> Either String (Map String Account))
-> Map String Account
-> [CollectionRule]
-> Either String (Map String Account)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map String Account
acc CollectionRule
rule -> Date
-> CollectionRule
-> Map PoolId (AssetCashflow, Maybe [AssetCashflow])
-> Map String Account
-> Either String (Map String Account)
depositInflow Date
d CollectionRule
rule Map PoolId (AssetCashflow, Maybe [AssetCashflow])
pFlowMap Map String Account
acc) Map String Account
amap [CollectionRule]
rules
$(deriveJSON defaultOptions ''CollectionRule)