1 {-# OPTIONS_GHC -fno-warn-orphans #-}
2 module Hcompta.LCC.Balance where
4 import Data.Function (flip)
5 import Data.Functor ((<$>))
6 import Data.Map.Strict (Map)
7 -- import Data.Foldable (Foldable(..))
9 import qualified Hcompta as H
11 import Hcompta.LCC.Amount
12 import Hcompta.LCC.Account
13 import Hcompta.LCC.Posting
14 import Hcompta.LCC.Transaction
15 import Hcompta.LCC.Journal
16 import Hcompta.LCC.Compta
18 import Data.Functor.Compose
19 import Data.Function ((.))
22 import qualified Data.MonoTraversable as MT
24 type Balance = H.Balance NameAccount Unit (H.Polarized Quantity)
25 type BalByAccount = H.BalByAccount NameAccount Unit (H.Polarized Quantity)
26 type BalByUnit = H.BalByUnit NameAccount Unit (H.Polarized Quantity)
27 type DeviationByUnit = H.DeviationByUnit NameAccount Unit (H.Polarized Quantity)
29 instance H.Sumable Balance (Account, Amounts) where
30 bal += (Account acct, Amounts amts) = bal H.+= (acct, H.polarize <$> amts)
31 instance H.Sumable Balance Posting where
32 bal += p = bal H.+= (posting_account p, posting_amounts p)
33 instance H.Sumable Balance Postings where
34 bal += Postings ps = MT.ofoldr (flip (H.+=)) bal ps
35 instance H.Sumable Balance Transaction where
36 bal += t = bal H.+= transaction_postings t
37 instance H.Sumable Balance a => H.Sumable Balance (Journal a) where
38 bal += j = bal H.+= journal_content j
39 instance H.Sumable Balance a => H.Sumable Balance (Journals a) where
40 bal += Journals js = MT.ofoldr (flip (H.+=)) bal js
41 instance H.Sumable Balance a => H.Sumable Balance (Compta src ss a) where
42 bal += c = bal H.+= compta_journals c
43 instance H.Sumable Balance (Map Date [Transaction]) where
44 bal += m = MT.ofoldr (flip (H.+=)) bal m
46 type Balanceable = H.Sumable Balance
47 balance :: Balanceable a => a -> Balance
51 consBal :: Posting -> Balance -> Balance
54 -- type instance H.Postings H.:@ Transaction = Postings
55 -- instance H.Get (H.Balance_Amounts Unit Quantity) [Transaction] where
56 -- get = transaction_postings
58 balancePosting :: Posting -> Balance -> Balance
59 balancePosting = H.consBal
60 balanceTransaction :: Transaction -> Balance -> Balance
61 balanceTransaction = H.balance . transaction_postings
62 balancePostings :: Postings -> Balance -> Balance
63 balancePostings = H.balance
64 balanceTransactions :: [Transaction] -> Balance -> Balance
65 balanceTransactions = flip $ foldr H.balance
67 balance :: Journal [Transaction] -> Balance -> Balance
68 balance = flip $ MT.ofoldr $ flip $ foldr H.balance
70 -- (Get (Balance_Account acct_sect) post, Get (Balance_Amounts unit qty) post, Addable qty, Ord acct_sect, Ord unit) => post -> Balance acct_sect unit qty -> Balance acct_sect unit qty
71 -- balance_postings :: (post ~ Element posts, MonoFoldable posts, Get (Balance_Account acct_sect) post, Get (Balance_Amounts unit qty) post, Addable qty, Ord acct_sect, Ord unit) => posts -> Balance acct_sect unit qty -> Balance acct_sect unit qty