lcc/Hcompta/LCC/Balance.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans #-}
   2 module Hcompta.LCC.Balance where
   3
   4 import Data.Function (flip)
   5 import Data.Functor ((<$>))
   6 import Data.Map.Strict (Map)
   7 -- import Data.Foldable (Foldable(..))
   8
   9 import qualified Hcompta as H
  10
  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
  17 {-
  18 import Data.Functor.Compose
  19 import Data.Function ((.))
  20
  21 -}
  22 import qualified Data.MonoTraversable as MT
  23
  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)
  28
  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
  45
  46 type Balanceable = H.Sumable Balance
  47 balance :: Balanceable a => a -> Balance
  48 balance = H.sum
  49
  50 {-
  51 consBal :: Posting -> Balance -> Balance
  52 consBal = H.consBal
  53
  54 -- type instance H.Postings H.:@ Transaction = Postings
  55 -- instance H.Get (H.Balance_Amounts Unit Quantity) [Transaction] where
  56 --      get = transaction_postings
  57
  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
  66
  67 balance :: Journal [Transaction] -> Balance -> Balance
  68 balance = flip $ MT.ofoldr $ flip $ foldr H.balance
  69
  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
  72 --}