lcc/Hcompta/LCC/Balance.hs

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