lcc/Hcompta/LCC/Balance.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 module Hcompta.LCC.Balance where
   4
   5 import Data.Ord (Ord)
   6 import Data.Bool (Bool(..))
   7 import Data.Maybe (Maybe(..))
   8 import Data.Function (($), flip)
   9 import Data.Functor ((<$>))
  10 import Data.Map.Strict (Map)
  11 -- import Data.Foldable (Foldable(..))
  12 -- import Data.Functor.Compose
  13 -- import Data.Function ((.))
  14 import qualified Data.List as L
  15 import qualified Data.MonoTraversable as MT
  16 import qualified Data.TreeMap.Strict as TM
  17 import qualified Data.Map.Strict as Map
  18
  19 import qualified Language.Symantic.Document as D
  20
  21 import qualified Hcompta as H
  22
  23 import Hcompta.LCC.Amount
  24 import Hcompta.LCC.Account
  25 import Hcompta.LCC.Posting
  26 import Hcompta.LCC.Transaction
  27 import Hcompta.LCC.Journal
  28 import Hcompta.LCC.Compta
  29
  30
  31 -- * Type 'Balance'
  32 type Balance         = H.Balance         NameAccount Unit (H.Polarized Quantity)
  33 type BalByAccount    = H.BalByAccount    NameAccount Unit (H.Polarized Quantity)
  34 type BalByUnit       = H.BalByUnit       NameAccount Unit (H.Polarized Quantity)
  35 type DeviationByUnit = H.DeviationByUnit NameAccount Unit (H.Polarized Quantity)
  36
  37 instance H.Sumable Balance (Account, Amounts) where
  38         bal += (Account acct, Amounts amts) = bal H.+= (acct, H.polarize <$> amts)
  39 instance H.Sumable Balance Posting where
  40         bal += p = bal H.+= (posting_account p, posting_amounts p)
  41 instance H.Sumable Balance Postings where
  42         bal += Postings ps = MT.ofoldr (flip (H.+=)) bal ps
  43 instance H.Sumable Balance Transaction where
  44         bal += t = bal H.+= transaction_postings t
  45 instance H.Sumable Balance a => H.Sumable Balance (Journal a) where
  46         bal += j = bal H.+= journal_content j
  47 instance H.Sumable Balance a => H.Sumable Balance (Journals a) where
  48         bal += Journals js = MT.ofoldr (flip (H.+=)) bal js
  49 instance H.Sumable Balance a => H.Sumable Balance (Compta src ss a) where
  50         bal += c = bal H.+= compta_journals c
  51 instance H.Sumable Balance (Map Date [Transaction]) where
  52         bal += m = MT.ofoldr (flip (H.+=)) bal m
  53
  54 -- * Class 'Balanceable'
  55 type Balanceable = H.Sumable Balance
  56 balance :: Balanceable a => a -> Balance
  57 balance = H.sum
  58