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

module Ledger (Ledger(..),entryLog,LedgerName,queryGap,clearLedgersBySeq
              ,queryDirection,entryLogByDr,bookToTarget)
    where
import qualified Data.Time as T
import Stmt 
import Types
import Lib
import Util
import Data.Aeson hiding (json)
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import qualified Data.DList as DL
import GHC.Generics

import Control.Lens hiding (element)

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


type LedgerName = String

data Ledger = Ledger {
    Ledger -> [Char]
ledgName :: String                              -- ^ ledger account name
    ,Ledger -> Balance
ledgBalance :: Balance                         -- ^ current balance of ledger
    ,Ledger -> Maybe Statement
ledgStmt :: Maybe Statement                    -- ^ ledger transaction history
} deriving (Int -> Ledger -> ShowS
[Ledger] -> ShowS
Ledger -> [Char]
(Int -> Ledger -> ShowS)
-> (Ledger -> [Char]) -> ([Ledger] -> ShowS) -> Show Ledger
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ledger -> ShowS
showsPrec :: Int -> Ledger -> ShowS
$cshow :: Ledger -> [Char]
show :: Ledger -> [Char]
$cshowList :: [Ledger] -> ShowS
showList :: [Ledger] -> ShowS
Show, (forall x. Ledger -> Rep Ledger x)
-> (forall x. Rep Ledger x -> Ledger) -> Generic Ledger
forall x. Rep Ledger x -> Ledger
forall x. Ledger -> Rep Ledger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ledger -> Rep Ledger x
from :: forall x. Ledger -> Rep Ledger x
$cto :: forall x. Rep Ledger x -> Ledger
to :: forall x. Rep Ledger x -> Ledger
Generic,Eq Ledger
Eq Ledger =>
(Ledger -> Ledger -> Ordering)
-> (Ledger -> Ledger -> Bool)
-> (Ledger -> Ledger -> Bool)
-> (Ledger -> Ledger -> Bool)
-> (Ledger -> Ledger -> Bool)
-> (Ledger -> Ledger -> Ledger)
-> (Ledger -> Ledger -> Ledger)
-> Ord Ledger
Ledger -> Ledger -> Bool
Ledger -> Ledger -> Ordering
Ledger -> Ledger -> Ledger
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 :: Ledger -> Ledger -> Ordering
compare :: Ledger -> Ledger -> Ordering
$c< :: Ledger -> Ledger -> Bool
< :: Ledger -> Ledger -> Bool
$c<= :: Ledger -> Ledger -> Bool
<= :: Ledger -> Ledger -> Bool
$c> :: Ledger -> Ledger -> Bool
> :: Ledger -> Ledger -> Bool
$c>= :: Ledger -> Ledger -> Bool
>= :: Ledger -> Ledger -> Bool
$cmax :: Ledger -> Ledger -> Ledger
max :: Ledger -> Ledger -> Ledger
$cmin :: Ledger -> Ledger -> Ledger
min :: Ledger -> Ledger -> Ledger
Ord, Ledger -> Ledger -> Bool
(Ledger -> Ledger -> Bool)
-> (Ledger -> Ledger -> Bool) -> Eq Ledger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ledger -> Ledger -> Bool
== :: Ledger -> Ledger -> Bool
$c/= :: Ledger -> Ledger -> Bool
/= :: Ledger -> Ledger -> Bool
Eq)

-- | Book an entry with date,amount and transaction to a ledger
entryLog :: Amount -> Date -> TxnComment -> Ledger -> Ledger
entryLog :: Balance -> Date -> TxnComment -> Ledger -> Ledger
entryLog Balance
amt Date
d TxnComment
cmt ledg :: Ledger
ledg@Ledger{ledgStmt :: Ledger -> Maybe Statement
ledgStmt = Maybe Statement
mStmt, ledgBalance :: Ledger -> Balance
ledgBalance = Balance
bal} 
  | BookDirection -> TxnComment -> Bool
isTxnDirection BookDirection
Credit TxnComment
cmt  = let 
                                   newBal :: Balance
newBal = Balance
bal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
amt
                                   txn :: Txn
txn = Date -> Balance -> Balance -> TxnComment -> Txn
EntryTxn Date
d Balance
newBal Balance
amt TxnComment
cmt
                                 in 
                                   Ledger
ledg { ledgStmt = appendStmt txn mStmt,ledgBalance = newBal }
  | Bool
otherwise = let 
                  newBal :: Balance
newBal = Balance
bal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
amt
                  txn :: Txn
txn = Date -> Balance -> Balance -> TxnComment -> Txn
EntryTxn Date
d Balance
newBal Balance
amt TxnComment
cmt
                in 
                  Ledger
ledg { ledgStmt = appendStmt txn mStmt ,ledgBalance = newBal }

-- TODO-- need to ensure there is no direction in input
entryLogByDr :: BookDirection -> Amount -> Date -> Maybe TxnComment -> Ledger -> Ledger
entryLogByDr :: BookDirection
-> Balance -> Date -> Maybe TxnComment -> Ledger -> Ledger
entryLogByDr BookDirection
dr Balance
amt Date
d Maybe TxnComment
Nothing = Balance -> Date -> TxnComment -> Ledger -> Ledger
entryLog Balance
amt Date
d (BookDirection -> TxnComment
TxnDirection BookDirection
dr)
entryLogByDr BookDirection
dr Balance
amt Date
d (Just TxnComment
cmt) 
  | Bool -> Bool
not (TxnComment -> Bool
hasTxnDirection TxnComment
cmt) = Balance -> Date -> TxnComment -> Ledger -> Ledger
entryLog Balance
amt Date
d ([TxnComment] -> TxnComment
TxnComments [BookDirection -> TxnComment
TxnDirection BookDirection
dr,TxnComment
cmt])
  | BookDirection -> TxnComment -> Bool
isTxnDirection BookDirection
dr TxnComment
cmt = Balance -> Date -> TxnComment -> Ledger -> Ledger
entryLog Balance
amt Date
d  TxnComment
cmt
  | Bool
otherwise = [Char] -> Ledger -> Ledger
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ledger -> Ledger) -> [Char] -> Ledger -> Ledger
forall a b. (a -> b) -> a -> b
$ [Char]
"Suppose direction"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ BookDirection -> [Char]
forall a. Show a => a -> [Char]
show BookDirection
dr[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"but got from comment"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TxnComment -> [Char]
forall a. Show a => a -> [Char]
show TxnComment
cmt

entryLogByDr BookDirection
Credit Balance
amt Date
d (Just (TxnComments [TxnComment]
cms)) = Balance -> Date -> TxnComment -> Ledger -> Ledger
entryLog Balance
amt Date
d ([TxnComment] -> TxnComment
TxnComments ((BookDirection -> TxnComment
TxnDirection BookDirection
Credit)TxnComment -> [TxnComment] -> [TxnComment]
forall a. a -> [a] -> [a]
:[TxnComment]
cms))
entryLogByDr BookDirection
Debit Balance
amt Date
d (Just (TxnComments [TxnComment]
cms)) = Balance -> Date -> TxnComment -> Ledger -> Ledger
entryLog Balance
amt Date
d ([TxnComment] -> TxnComment
TxnComments ((BookDirection -> TxnComment
TxnDirection BookDirection
Debit)TxnComment -> [TxnComment] -> [TxnComment]
forall a. a -> [a] -> [a]
:[TxnComment]
cms))

hasTxnDirection :: TxnComment -> Bool
hasTxnDirection :: TxnComment -> Bool
hasTxnDirection (TxnDirection BookDirection
_) = Bool
True
hasTxnDirection (TxnComments [TxnComment]
txns) = (TxnComment -> Bool) -> [TxnComment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TxnComment -> Bool
hasTxnDirection [TxnComment]
txns
hasTxnDirection TxnComment
_ = Bool
False

isTxnDirection :: BookDirection -> TxnComment -> Bool 
isTxnDirection :: BookDirection -> TxnComment -> Bool
isTxnDirection BookDirection
Credit (TxnDirection BookDirection
Credit) = Bool
True
isTxnDirection BookDirection
Debit (TxnDirection BookDirection
Debit) = Bool
True
isTxnDirection BookDirection
Credit (TxnComments [TxnComment]
txns) = (TxnComment -> Bool) -> [TxnComment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (BookDirection -> TxnComment -> Bool
isTxnDirection BookDirection
Credit) [TxnComment]
txns
isTxnDirection BookDirection
Debit (TxnComments [TxnComment]
txns) = (TxnComment -> Bool) -> [TxnComment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (BookDirection -> TxnComment -> Bool
isTxnDirection BookDirection
Debit) [TxnComment]
txns
isTxnDirection BookDirection
_ TxnComment
_ = Bool
False

-- ^ credit is negative amount
queryDirection :: Ledger -> (BookDirection ,Balance) 
queryDirection :: Ledger -> (BookDirection, Balance)
queryDirection (Ledger [Char]
_ Balance
bal Maybe Statement
_)
  |  Balance
bal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
>= Balance
0 = (BookDirection
Debit, Balance
bal)
  |  Balance
bal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
< Balance
0 = (BookDirection
Credit, Balance -> Balance
forall a. Num a => a -> a
negate Balance
bal)

bookToTarget :: Ledger -> (BookDirection,Amount) -> (BookDirection,Amount)
bookToTarget :: Ledger -> (BookDirection, Balance) -> (BookDirection, Balance)
bookToTarget Ledger{ledgBalance :: Ledger -> Balance
ledgBalance = Balance
bal} (BookDirection
dr, Balance
targetBal) 
  = case (Balance
bal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0, BookDirection
dr) of 
      (Bool
True, BookDirection
Debit) -> 
        if (Balance
targetBal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
bal)  then 
          (BookDirection
Debit,Balance
targetBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
bal)
        else 
          (BookDirection
Credit,Balance
bal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
targetBal)
      (Bool
False, BookDirection
Credit) ->
        if (Balance
targetBal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance -> Balance
forall a. Num a => a -> a
abs Balance
bal)  then 
          (BookDirection
Credit,Balance
targetBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance -> Balance
forall a. Num a => a -> a
abs Balance
bal)
        else 
          (BookDirection
Debit, Balance -> Balance
forall a. Num a => a -> a
abs Balance
bal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
targetBal)
      (Bool
True, BookDirection
Credit) -> 
        (BookDirection
Credit,Balance
targetBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance
bal)
      (Bool
False, BookDirection
Debit) ->
        (BookDirection
Debit,Balance
targetBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
+ Balance -> Balance
forall a. Num a => a -> a
abs Balance
bal)


-- ^ return ledger's bookable amount (for netting off to zero ) with direction input
queryGap :: BookDirection -> Ledger -> Balance
queryGap :: BookDirection -> Ledger -> Balance
queryGap BookDirection
dr Ledger{ledgBalance :: Ledger -> Balance
ledgBalance = Balance
bal}  
  = case (Balance
bal Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0, BookDirection
dr) of 
      (Bool
True, BookDirection
Debit) -> Balance
0
      (Bool
True, BookDirection
Credit) -> Balance
bal
      (Bool
False, BookDirection
Debit) -> Balance -> Balance
forall a. Num a => a -> a
negate Balance
bal 
      (Bool
False, BookDirection
Credit) -> Balance
0

clearLedgersBySeq :: BookDirection -> Date -> Amount -> [Ledger] -> [Ledger] -> ([Ledger],Amount)
clearLedgersBySeq :: BookDirection
-> Date -> Balance -> [Ledger] -> [Ledger] -> ([Ledger], Balance)
clearLedgersBySeq BookDirection
dr Date
d Balance
0 [Ledger]
rs [Ledger]
unAllocLedgers = ([Ledger]
rs[Ledger] -> [Ledger] -> [Ledger]
forall a. [a] -> [a] -> [a]
++[Ledger]
unAllocLedgers,Balance
0)
clearLedgersBySeq BookDirection
dr Date
d Balance
amtToAlloc [Ledger]
rs [] = ([Ledger]
rs,Balance
amtToAlloc)
clearLedgersBySeq BookDirection
dr Date
d Balance
amtToAlloc [Ledger]
rs (ledger :: Ledger
ledger@Ledger{ledgBalance :: Ledger -> Balance
ledgBalance = Balance
bal}:[Ledger]
ledgers)  
  = let 
      deductAmt :: Balance
deductAmt = BookDirection -> Ledger -> Balance
queryGap BookDirection
dr Ledger
ledger
      allocAmt :: Balance
allocAmt = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
deductAmt Balance
amtToAlloc
      remainAmt :: Balance
remainAmt = Balance
amtToAlloc Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
allocAmt
      newLedger :: Ledger
newLedger = Balance -> Date -> TxnComment -> Ledger -> Ledger
entryLog Balance
allocAmt Date
d (BookDirection -> TxnComment
TxnDirection BookDirection
dr) Ledger
ledger
    in 
      BookDirection
-> Date -> Balance -> [Ledger] -> [Ledger] -> ([Ledger], Balance)
clearLedgersBySeq BookDirection
dr Date
d Balance
remainAmt (Ledger
newLedgerLedger -> [Ledger] -> [Ledger]
forall a. a -> [a] -> [a]
:[Ledger]
rs) [Ledger]
ledgers

instance QueryByComment Ledger where 
    queryStmt :: Ledger -> TxnComment -> [Txn]
queryStmt (Ledger [Char]
_ Balance
_ Maybe Statement
Nothing) TxnComment
tc = []
    queryStmt (Ledger [Char]
_ Balance
_ (Just (Statement DList Txn
txns))) TxnComment
tc
      = (Txn -> Bool) -> [Txn] -> [Txn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Txn
x -> Txn -> TxnComment
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)

    queryTxnAmt :: Ledger -> TxnComment -> Balance
queryTxnAmt Ledger
a TxnComment
tc = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ (Txn -> Balance) -> [Txn] -> [Balance]
forall a b. (a -> b) -> [a] -> [b]
map Txn -> Balance
getTxnAmt ([Txn] -> [Balance]) -> [Txn] -> [Balance]
forall a b. (a -> b) -> a -> b
$ Ledger -> TxnComment -> [Txn]
forall a. QueryByComment a => a -> TxnComment -> [Txn]
queryStmt Ledger
a TxnComment
tc

makeLensesFor [("ledgName","ledgNameLens"),("ledgBalance","ledgBalLens"),("ledgStmt","ledgStmtLens")] ''Ledger


$(deriveJSON defaultOptions ''Ledger)