{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.JCC.Posting where

import           Control.DeepSeq (NFData(..))
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Function ((.), flip)
import           Data.Functor ((<$>))
import qualified Data.List as List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
import           Data.Tuple (uncurry)
import           Data.Typeable (Typeable)
import           Prelude (seq)
import           Text.Parsec.Pos (SourcePos, initialPos)
import           Text.Show (Show)

import qualified Hcompta as H

import           Hcompta.JCC.Account
import           Hcompta.JCC.Amount
import           Hcompta.JCC.Chart

-- * Type 'Posting'

data Posting
 =   Posting
 {   posting_account        :: Account
 ,   posting_account_anchor :: Maybe (H.Account_Anchor, Maybe Account)
 ,   posting_amounts        :: Map Unit Quantity
 ,   posting_anchors        :: H.Posting_Anchors
 ,   posting_comments       :: [Comment]
 ,   posting_dates          :: [H.Date]
 ,   posting_sourcepos      :: SourcePos
 ,   posting_tags           :: H.Posting_Tags
 } deriving (Data, Eq, Show, Typeable)
instance NFData Posting where
	rnf Posting{..} =
		rnf posting_account `seq`
		rnf posting_account_anchor `seq`
		rnf posting_amounts `seq`
		rnf posting_anchors `seq`
		rnf posting_comments `seq`
		rnf posting_dates `seq`
		-- rnf posting_sourcepos `seq`
		rnf posting_tags

posting :: Account -> Posting
posting acct =
	Posting
	 { posting_account        = acct
	 , posting_account_anchor = Nothing
	 , posting_amounts        = mempty
	 , posting_anchors        = mempty
	 , posting_comments       = mempty
	 , posting_dates          = mempty
	 , posting_sourcepos      = initialPos ""
	 , posting_tags           = mempty
	 }

postings_by_account :: [Posting] -> Map Account [Posting]
postings_by_account =
	Map.fromListWith (flip mappend) .
	List.map (\p -> (posting_account p, [p]))

-- Posting
instance H.Posting Posting where
	type Posting_Account Posting = Account
	type Posting_Amount  Posting = Amount
	type Posting_Amounts Posting = [Amount]
	posting_account = posting_account
	posting_amounts = (uncurry Amount <$>) . Map.toList . posting_amounts
instance H.Posting (Charted Posting) where
	type Posting_Account (Charted Posting) = Charted Account
	type Posting_Amount  (Charted Posting) = H.Posting_Amount  Posting
	type Posting_Amounts (Charted Posting) = H.Posting_Amounts Posting
	posting_account = (H.posting_account <$>)
	posting_amounts = H.posting_amounts . charted

-- Balance
instance H.Balance_Posting Posting where
	type Balance_Posting_Quantity Posting = H.Polarized Quantity
	balance_posting_amounts = (H.polarize <$>) . posting_amounts
	balance_posting_amounts_set amounts p =
		p { posting_amounts = H.depolarize <$> amounts }
instance H.Balance_Posting (Charted Posting) where
	type Balance_Posting_Quantity (Charted Posting) = H.Balance_Posting_Quantity Posting
	balance_posting_amounts = H.balance_posting_amounts . charted
	balance_posting_amounts_set amounts (Charted c p) =
		Charted c p{ posting_amounts = H.depolarize <$> amounts }

-- GL
instance H.GL_Posting Posting where
	type GL_Posting_Quantity Posting = Map Unit (H.Polarized Quantity)
	gl_posting_quantity = (H.polarize <$>) . posting_amounts
instance H.GL_Posting (Charted Posting) where
	type GL_Posting_Quantity (Charted Posting) = H.GL_Posting_Quantity Posting
	gl_posting_quantity = H.gl_posting_quantity . charted

-- ** Type 'Comment'

type Comment = Text