{-# 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