{-# LANGUAGE AllowAmbiguousTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Hcompta.LCC.Balance where import Data.Function (flip) import Data.Functor ((<$>)) import Data.Map.Strict (Map) -- import Data.Foldable (Foldable(..)) -- import Data.Functor.Compose -- import Data.Function ((.)) import qualified Data.MonoTraversable as MT import qualified Hcompta as H import Hcompta.LCC.Amount import Hcompta.LCC.Account import Hcompta.LCC.Posting import Hcompta.LCC.Transaction import Hcompta.LCC.Journal -- import Hcompta.LCC.Compta -- * Type 'Balance' type Balance = H.Balance NameAccount Unit (H.Polarized Quantity) type BalByAccount = H.BalByAccount NameAccount Unit (H.Polarized Quantity) type ClusiveBalByAccount = H.ClusiveBalByAccount NameAccount Unit (H.Polarized Quantity) type BalByUnit = H.BalByUnit NameAccount Unit (H.Polarized Quantity) type DeviationByUnit = H.DeviationByUnit NameAccount Unit (H.Polarized Quantity) instance H.Sumable Balance (Account, Amounts) where bal += (Account acct, Amounts amts) = bal H.+= (acct, H.polarize <$> amts) instance H.Sumable Balance (Posting src) where bal += p = bal H.+= (posting_account p, posting_amounts p) instance H.Sumable Balance (Postings src) where bal += Postings ps = MT.ofoldr (flip (H.+=)) bal ps instance H.Sumable Balance (Transaction src) where bal += t = bal H.+= transaction_postings t instance H.Sumable Balance (Transactions src) where bal += Transactions ts = MT.ofoldr (flip (H.+=)) bal ts instance H.Sumable Balance a => H.Sumable Balance (Journal src a) where bal += j = bal H.+= journal_content j instance H.Sumable Balance a => H.Sumable Balance (Journals src a) where bal += Journals js = MT.ofoldr (flip (H.+=)) bal js {- instance H.Sumable Balance a => H.Sumable Balance (Compta src ss a) where bal += c = bal H.+= compta_journals c -} instance H.Sumable Balance (Map Date [Transaction src]) where bal += m = MT.ofoldr (flip (H.+=)) bal m {- -- * Class 'Balanceable' type Balanceable = H.Sumable Balance balance :: Balanceable a => a -> Balance balance = H.sum -}