{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.LCC.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 qualified Data.TreeMap.Strict as TreeMap
import           Data.Typeable (Typeable)
import           Prelude (seq)
import           Text.Parsec.Pos (SourcePos, initialPos)
import           Text.Show (Show)
import qualified Data.MonoTraversable as MT

import qualified Hcompta as H

import           Hcompta.LCC.Account
import           Hcompta.LCC.Amount
import           Hcompta.LCC.Anchor
import           Hcompta.LCC.Tag

-- * Type 'Posting'
data Posting
 =   Posting
 {   posting_account        :: Account
 ,   posting_account_anchor :: Maybe (Account_Anchor, Maybe Account)
 ,   posting_amounts        :: Amounts
 ,   posting_anchors        :: Posting_Anchors
 ,   posting_comments       :: [Comment]
 ,   posting_dates          :: [Date]
 ,   posting_sourcepos      :: SourcePos
 ,   posting_tags           :: 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
instance H.Get (TreeMap.Path Account_Section) Posting where
	get = H.get . posting_account
instance H.Get (Map Unit (H.Polarized Quantity)) Posting where
	get Posting{posting_amounts = Amounts amts} = H.polarize <$> amts
instance H.Set (Map Unit (H.Polarized Quantity)) Posting where
	set amts p = p{posting_amounts = Amounts $ H.depolarize <$> amts}

posting :: Account -> Posting
posting acct =
	Posting
	 { posting_account        = acct
	 , posting_account_anchor = Nothing
	 , posting_amounts        = H.quantity_zero
	 , 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]))

instance H.Posting Posting

type instance H.Account H.:@ Posting = Account
instance H.GetI H.Account Posting where
	getI _ = posting_account
instance H.SetI H.Account Posting where
	setI _ posting_account p = p{posting_account}

type instance H.Amounts H.:@ Posting = Amounts
instance H.GetI H.Amounts Posting where
	getI _ = posting_amounts
instance H.SetI H.Amounts Posting where
	setI _ posting_amounts p = p{posting_amounts}

-- * Type 'Posting_Anchor'
newtype Posting_Anchor = Posting_Anchor Anchor
 deriving (Data, Eq, NFData, Show, Typeable)
-- * Type 'Posting_Anchors'
newtype Posting_Anchors = Posting_Anchors Anchors
 deriving (Data, Eq, Monoid, NFData, Show, Typeable)
type instance MT.Element Posting_Anchors = Posting_Anchor

-- * Type 'Posting_Tag'
newtype Posting_Tag = Posting_Tag Tag
 deriving (Data, Eq, NFData, Show, Typeable)
-- * Type 'Posting_Tags'
newtype Posting_Tags = Posting_Tags Tags
 deriving (Data, Eq, Monoid, NFData, Show, Typeable)
type instance MT.Element Posting_Tags = Posting_Tag

-- ** Type 'Comment'
newtype Comment = Comment Text
 deriving (Data, Eq, NFData, Show, Typeable)

-- * Type 'Postings'
newtype Postings = Postings (Map Account [Posting])
 deriving (Data, Eq, NFData, Show, Typeable)
instance Monoid Postings where
	mempty = Postings mempty
	mappend (Postings x) (Postings y) =
		Postings $ Map.unionWith (flip mappend) x y

type instance MT.Element Postings = Posting
instance H.Postings Postings


{-
-- Posting
instance H.Posting Posting where
	type Posting_Account Posting = Account
	type Posting_Amount  Posting = Amount
	type 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 Amounts (Charted Posting) = H.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
-}